home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / C / LIB / PARI / PARI1 / pari / other / mp_s
Text File  |  1991-11-28  |  256KB  |  6,678 lines
  1. #*******************************************************************#
  2. #===================================================================#
  3. #*                                                                 *#
  4. #=                                                                 =#
  5. #*                                                                 *#
  6. #=     oooooooooo          ooooo       oooooooooo      ooooo       =#
  7. #*      ooooooooooo      ooooooooo      ooooooooooo     ooo        *#
  8. #*      ooo     ooo     ooo     ooo     ooo     ooo     ooo        *#
  9. #=      ooo     ooo     ooo     ooo     ooo     ooo     ooo        =#
  10. #*      ooooooooooo     ooooooooooo     oooooooooo      ooo        *#
  11. #=      oooooooooo      ooooooooooo     ooooooooooo     ooo        =#
  12. #*      ooo             ooo     ooo     ooo     ooo     ooo        *#
  13. #=      ooo             ooo     ooo     ooo     ooo     ooo        =#
  14. #*     ooooo           ooooo   ooooo   ooooo   ooooo   ooooo       *#
  15. #*                                                                 *#
  16. #=                                                                 =#
  17. #*                      version numero 2                           *#
  18. #*                                                                 *#
  19. #=                          commentee                              =#
  20. #*                                                                 *#
  21. #=                 fichier cree le 22 sept. 1987                   =#
  22. #*                                                                 *#
  23. #=                              par                                =#
  24. #*                                                                 *#
  25. #=        christian batut , henri cohen , michel olivier           =#
  26. #*                                                                 *#
  27. #=        """"""""""""""""""""""""""""""""""""""""""""""           =#
  28. #*                                                                 *#
  29. #=                                                          =#
  30. #*                                                                 *#
  31. #===================================================================#
  32. #*******************************************************************#
  33.  
  34.  
  35.  
  36.  
  37. #-------------------------------------------------------------------#
  38. #                                                                   #
  39. #  Notations :                                                      #
  40. #               T = type ( S , I , ou R ).                          #
  41. #               R = type reel.                                      #
  42. #               S = type entier court ( long du C).                 #
  43. #               P = p-adique.                                       #
  44. #                                                                   #
  45. #               L = longueur de la mantisse pour un reel ;          #
  46. #                   longueur de la mantisse effective pour un entier#
  47. #               l = longueur totale du nombre avec codage.          #
  48. #               le= longueur effective totale de l'entier avec code #
  49. #                   on doit avoir : l <= 2^15-1.                    #
  50. #                                                                   #
  51. #               exp = exposant non biaise d'un reel.                #
  52. #               fexp= exposant biaise ( fexp = exp + 2^23 ).        #
  53. #                     on doit avoir : -2^23 <= exp < 2^23           #
  54. #               fvalp=valuation p-adique biaisee d'un p-adique.     #
  55. #                     ( fvalp = valuation + 2^15 )                  #
  56. #                                                                   #
  57. #-------------------------------------------------------------------#
  58.  
  59.  
  60.  
  61.  
  62. #-------------------------------------------------------------------#
  63. #                                                                   #
  64. #   Conventions :                                                   #
  65. #               Tous les sous programmes creent la place necessaire #
  66. #               pour stocker le resultat , a l'exception des        #
  67. #               programmes d'affectation et d'echange , ainsi que   #
  68. #               des programmes dont le nom se termine par la lettre #
  69. #               "z" . On entre dans ces derniers avec une zone creee#
  70. #               dans la pile PARI ou le resultat est range.         #
  71. #                                                                   #
  72. #               Le nombre reel 0 s'ecrit avec mantisse non          #
  73. #               significative;le deuxieme lgmot code contient       #
  74. #               -32*L + (2^23) ou L est la longueur de la mantisse  #
  75. #                                                                   #
  76. #               Les registres a0,a1,d0,d1 sont en general utilises  #
  77. #               par les programmes et ne sont pas restaures a leurs #
  78. #               valeurs d'entree.Tous les autres sont sauvegardes.  #
  79. #                                                                   #
  80. #               Les objets utilises par PARI sont crees dans une    #
  81. #               pile dite dans la suite "pile PARI",pointee par     #
  82. #               _avma.                                              #
  83. #                                                                   #
  84. #-------------------------------------------------------------------#
  85.  
  86.  
  87.  
  88.  
  89.  
  90. affer1  =       1
  91. affer2  =       2
  92. affer3  =       3
  93. affer4  =       4
  94. affer5  =       5
  95. exger1  =       6
  96. exger2  =       7
  97. shier1  =       8
  98. shier2  =       9
  99. truer1  =       10
  100. truer2  =       11
  101. adder1  =       12
  102. adder2  =       13
  103. adder3  =       14
  104. adder4  =       15
  105. adder5  =       16
  106. muler1  =       17
  107. muler2  =       18
  108. muler3  =       19
  109. muler4  =       20
  110. muler5  =       21
  111. muler6  =       22
  112. diver1  =       23
  113. diver2  =       24
  114. diver3  =       25
  115. diver4  =       26
  116. diver5  =       27
  117. diver6  =       28
  118. diver7  =       29
  119. diver8  =       30
  120. diver9  =       31
  121. diver10 =       32
  122. diver11 =       33
  123. diver12 =       34
  124. divzer1 =       35
  125. dvmer1  =       36
  126. dvmzer1 =       37
  127. moder1  =       38
  128. modzer1 =       39
  129. reser1  =       40
  130. reszer1 =       41
  131. arier1  =       42
  132. arier2  =       43
  133. errpile =       44
  134. rtodber =       45
  135. gerper  =       46
  136.  
  137.  
  138.         .text
  139.  
  140.         .globl  _typ,_lg,_lgef,_mant,_signe,_expo,_pere,_valp,_precp,_varn
  141.         .globl  _settyp,_setlg,_setlgef,_setmant,_setsigne,_setexpo,_expi
  142.         .globl  _setpere,_incpere,_setvalp,_setprecp,_setvarn
  143.         .globl  _cget,_cgetg,_cgeti,_cgetr,_cgiv,_gerepile
  144.         .globl  _mpaff,_affsz,_affsi,_affsr,_affii,_affir
  145.         .globl  _affrs,_affri,_affrr
  146.         .globl  _stoi,_itos
  147.         .globl  _mpneg,_mpnegz,_negs,_negi,_negr
  148.         .globl  _mpabs,_mpabsz,_abss,_absi,_absr
  149.         .globl  _mptrunc,_mptruncz,_mpent,_mpentz
  150.         .globl  _mpexg,_vals,_vali
  151.         .globl  _mpshift,_mpshiftz,_shifts,_shifti,_shiftr
  152.         .globl  _mpcmp,_cmpss,_cmpsi,_cmpsr,_cmpis,_cmpii,_cmpir
  153.         .globl  _cmprs,_cmpri,_cmprr
  154.         .globl  _mpadd,_addss,_addsi,_addsr,_addii,_addir,_addrr
  155.         .globl  _mpaddz,_addssz,_addsiz,_addsrz,_addiiz,_addirz,_addrrz
  156.         .globl  _mpsub,_subss,_subsi,_subsr,_subis,_subii,_subir
  157.         .globl  _subrs,_subri,_subrr
  158.         .globl  _mpsubz,_subssz,_subsiz,_subsrz,_subisz,_subiiz,_subirz
  159.         .globl  _subrsz,_subriz,_subrrz
  160.         .globl  _mpmul,_mulss,_mulsi,_mulsr,_mulii,_mulir,_mulrr
  161.         .globl  _mpmulz,_mulssz,_mulsiz,_mulsrz,_muliiz,_mulirz,_mulrrz
  162.         .globl  _dvmdss,_dvmdsi,_dvmdis,_dvmdii
  163.         .globl  _mpdvmdz,_dvmdssz,_dvmdsiz,_dvmdisz,_dvmdiiz
  164.         .globl  _mpdiv,_divss,_divsi,_divsr,_divis,_divii,_divir
  165.         .globl  _divrs,_divri,_divrr
  166.         .globl  _mpdivis,_divise
  167.         .globl  _mpdivz,_divssz,_divsiz,_divsrz,_divisz,_diviiz,_divirz
  168.         .globl  _divrsz,_divriz,_divrrz
  169.         .globl  _mpinvz,_mpinvsr,_mpinvir,_mpinvrr
  170.         .globl  _modss,_modsi,_modis,_modii
  171.         .globl  _mpmodz,_modssz,_modsiz,_modisz,_modiiz
  172.         .globl  _resss,_ressi,_resis,_resii
  173.         .globl  _mpresz,_resssz,_ressiz,_resisz,_resiiz
  174.         .globl  _convi,_confrac
  175.         .globl  _addsii,_mulsii,_divisii
  176.     .globl    _mulmodll
  177.  
  178. #*******************************************************************#
  179. #*******************************************************************#
  180. #**                                                               **#
  181. #**             PROGRAMMES DE GESTION DE LA MEMOIRE PARI          **#
  182. #**                                                               **#
  183. #*******************************************************************#
  184. #*******************************************************************#
  185.  
  186.  
  187.  
  188. #===================================================================#
  189. #                                                                   #
  190. #           Allocation memoire dans pile PARI en C                  #
  191. #                                                                   #
  192. #       entree : a7@(4) contient la longueur totale a attribuer     #
  193. #       sortie : d0 pointe sur un type I ou R                       #
  194. #                d1 et a1 sont inutilises                           #
  195. #                                                                   #
  196. #===================================================================#
  197.  
  198. _cget:  movl    sp@(4),d0
  199.         bsr     get
  200.         movl    a0,d0
  201.         rts
  202.  
  203. _cgetg: movl    sp@(8),d0       | a7@(8) contient le type
  204.         rorl    #8,d0
  205.         movw    sp@(6),d0
  206.         bsr     get
  207.         movl    a0,d0
  208.         rts
  209.         
  210. _cgeti: movl    sp@(4),d0
  211.         bsr     geti
  212.         movl    a0,d0
  213.         rts
  214.  
  215. _cgetr: movl    sp@(4),d0
  216.         bsr     getr
  217.         movl    a0,d0
  218.         rts
  219.  
  220. #===================================================================#
  221. #                                                                   #
  222. #               Allocation memoire dans pile PARI                   #
  223. #                                                                   #
  224. #       entree : d0.w contient le nombre total de longs mots        #
  225. #                demandes si type I ou R                            #
  226. #       sortie : a0 pointe sur la zone allouee ; _avma est mis      #
  227. #                a jour ; message d'erreur si memoire insuffisante ;#
  228. #                d0 est inchange;d1 et a1 sont sauvegardes.         #
  229. #       remarque : il est interdit de creer des type S dans la pile #
  230. #                                                                   #
  231. #===================================================================#
  232.  
  233.                                 | allocation memoire type qcque
  234.  
  235. get:    movl    d1,sp@-         | d0.l contient code et longueur
  236.         moveq   #0,d1
  237.         movw    d0,d1
  238.         lsll    #2,d1
  239.         movl    _avma,a0
  240.         subl    d1,a0
  241.         cmpl    _bot,a0
  242.         bmi     mnet
  243.         movl    a0,_avma
  244.         swap    d0
  245.         movb    #1,d0
  246.         swap    d0
  247.         movl    d0,a0@
  248.         movl    sp@+,d1
  249.         rts
  250.  
  251.                                 | allocation memoire de type I
  252.  
  253. geti:   movl    d1,sp@-
  254.         moveq   #0,d1
  255.         movw    d0,d1
  256.         lsll    #2,d1
  257.         movl    _avma,a0
  258.         subl    d1,a0
  259.         cmpl    _bot,a0
  260.         bmi     mnet
  261.         movl    a0,_avma
  262.         movw    #0x101,a0@
  263.         movw    d0,a0@(2)
  264.         movl    sp@+,d1
  265.         rts
  266.  
  267.                                 | allocation memoire type R
  268.  
  269. getr:   movl    d1,sp@-
  270.         moveq   #0,d1
  271.         movw    d0,d1
  272.         lsll    #2,d1
  273.         movl    _avma,a0
  274.         subl    d1,a0
  275.         cmpl    _bot,a0
  276.         bmi     mnet
  277.         movl    a0,_avma
  278.         movw    #0x201,a0@
  279.         movw    d0,a0@(2)
  280.         movl    sp@+,d1
  281.         rts
  282.  
  283.                                 | nettoyage pile PARI
  284.                                 | a ecrire .....!!!!!!!!!
  285. mnet:   movl    #errpile,sp@-
  286.         jsr     _err
  287.  
  288. #===================================================================#
  289. #                                                                   #
  290. #               Desallocation memoire PARI en C                     #
  291. #                                                                   #
  292. #       entree : a7@(4) pointe sur un type I ou R                   #
  293. #       sortie : la zone occupee est desallouee                     #
  294. #                                                                   #
  295. #===================================================================#
  296.  
  297.  
  298. _cgiv:  movl    sp@(4),a0       | est suivi par giv
  299.                                 
  300.  
  301. #===================================================================#
  302. #                                                                   #
  303. #               Desallocation memoire PARI                          #
  304. #                                                                   #
  305. #       entree : a0@ contient le premier long mot code d'une        #
  306. #                zone memoire a desallouer : uniquement de type     #
  307. #                I ou R                                             #
  308. #       sortie : _avma est mis a jour si necessaire ; ou bien le    #
  309. #                nombre de peres de la zone est decremente.         #
  310. #                a0 pointe sur avma a jour                          #
  311. #                tous les autres registres sont inchanges           #
  312. #                                                                   #
  313. #===================================================================#
  314.  
  315. giv:    movl    d0,sp@-
  316.         cmpb    #0xff,a0@(1)    | comparaison nb peres avec 255
  317.         beq     givf
  318.                                 | ici le nb de peres est non sature
  319.         cmpl    _avma,a0
  320.         beq     giv1
  321.                                 | ici diminuer le nb de peres de 1
  322.         subb    #1,a0@(1)
  323. givf:   movl    sp@+,d0
  324.         rts
  325.                                 | ici la zone est en tete de pile
  326. giv1:   subb    #1,a0@(1)
  327.         bne     givf
  328.                                 | ici on desalloue la zone
  329. 1$:     movw    a0@(2),d0
  330.         lea     a0@(0,d0:w:4),a0| a0 pointe sur zone suivante
  331.         movl    a0,_avma
  332.         tstb    a0@(1)
  333.         beq     1$              | aller desallouer zone suivante
  334.         bra     givf            | si zone suivante a un seul pere
  335.                                 | ou si a0 = top memoire ( cf init)
  336.  
  337. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
  338. #                                                                 #
  339. #                       GESTION DE PILE                           #
  340. #                                                                 #
  341. #       Entree : sp@(4) et sp@(8) contiennent 2 adresses l > p    #
  342. #                sp@(12) contient 0 ou une adresse q ;            #
  343. #                                                                 #
  344. #       Sortie : la zone entre p et l est ecrasee ;               #
  345. #       -        la zone entre avma et p est decalee d'autant ;   #
  346. #       -        tous les pointeurs situes dans cette derniere    #
  347. #                zone et qui pointent avant p sont mis a jour     #
  348. #                et q est augmente du decalage .                  #
  349. #                ( d0 contient celui ci ou le decalage en octets )#
  350. #       -        de plus si q est non nul la racine pointee par l #
  351. #                est mise a jour si il y a lieu .                 #
  352. #       -        avma est mis a jour ( augmente du decalage )     #
  353. #                                                                 #
  354. #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#
  355.  
  356. _gerepile: moveml d2-d6/a2-a3,sp@-
  357.         movl    _avma,d5
  358.         movl    sp@(32),d2        | l adresse fin de la zone a detruire
  359.         movl    d2,a0
  360.         movl    d2,d4
  361.         movl    sp@(36),d1        | p adresse deb de la zone a detruire
  362.         movl    d1,a1
  363.         movl    d1,d0
  364.         subl    d0,d2             | decalage ( en octets ) = l - p
  365.         bhi     10$               | si l <= p rien a faire
  366.         movl    sp@(40),d0
  367.         bra     9$
  368. 10$:    subl    d5,d1
  369.         lsrl    #2,d1             | nb de lg mots a decaler
  370.         bra     2$
  371. 1$:     movl    a1@-,a0@-
  372. 2$:     dbra    d1,1$             | boucle de decalage
  373.     subl    #0x10000,d1
  374.     bge    1$
  375.         movl    a0,_avma          | nouvel avma et debut zone recopiee
  376.         clrl    d3
  377.         lea     _lontyp,a3        | tableau des types
  378. #---------------------------------| mise a jour de la zone recopiee :
  379.                                   | d4 pointe debut zone recopiee
  380.                                   | a0 pointe apres fin zone recopiee
  381. 3$:     movb    a0@,d3            | type de la zone examinee
  382.     movl    a3@(0,d3:w:4),d1  | d1 recoit lontyp[typ(l1)]
  383.         lea     a0@(0,d1:l:4),a1  | a1 pointe sur le dernier mot code
  384.     movw    a0@(2),d1         | longueur de la zone examinee
  385.     movl    a0,a2
  386.         lea     a0@(0,d1:w:4),a0  | a0 pointe apres fin de la zone
  387.     cmpb    #10,d3          | type polynome ?
  388.     bne    13$
  389.     movw    a2@(6),d6      | oui, longueur effective  > vraie longueur
  390.     cmpw    d1,d6
  391.     bhi    6$          | si oui, la zone est finie.
  392.     lea    a2@(0,d6:w:4),a2  | 
  393.     bra    4$
  394. 13$:    movl    a0,a2
  395.     subql    #4,a1
  396. 8$:     addql   #4,a1             | passer au lgmot suivant de la zone examinee
  397. 4$:     cmpl    a2,a1             | a t'on fini pour cette zone
  398.         bcc     6$                | si oui zone suivante
  399.         cmpl    a1@,d0            | sinon le lgmot examine pointe t'il avant p ?
  400.         bls     5$                | sinon ne rien faire
  401.         cmpl    a1@,d5            | si oui, verifier que le long mot examine
  402.         bhi     8$                | pointe apres avma
  403.         addl    d2,a1@+           | si oui ajouter decalage
  404.         bra     4$
  405. 5$:     cmpl    a1@+,d4           | le longmot pointe t'il apres l ?
  406.         bls     4$                | si oui ok
  407.     cmpl    d4,a0
  408.     bhi    4$
  409.         movl    #gerper,sp@-      | sinon erreur
  410.         jsr     _err
  411. 6$:     cmpl    d4,a0             | a t'on fini ?
  412.         bcs     3$                | si a0 < d4 non : traiter zone suivante
  413.         bne     7$                | si a0 > d4 oui
  414.         tstl    sp@(40)           | si a0 = d4 et q = 0 oui
  415.         bne     3$                | sinon traiter zone suivante :
  416.  
  417. 7$:     movl    d0,d1
  418.     movl    sp@(40),d0
  419.         beq     11$
  420.         cmpl    d0,d1             | si q pointe apres p retourner q
  421.         bls     9$                | sinon
  422.         cmpl    d0,d5
  423.         bhi     9$
  424. 11$:    addl    d2,d0             | retourner q + decalage ( ou decalage )
  425. 9$:     moveml  sp@+,d2-d6/a2-a3
  426.         rts
  427.  
  428.  
  429. #*******************************************************************#
  430. #*******************************************************************#
  431. #**                                                               **#
  432. #**     TYPE , MANTISSE , LONGUEUR , EXPOSANT , SIGNE .           **#
  433. #**                                                               **#
  434. #**     VALUATION , PRECISION DES P-ADIQUES , VARIABLES.          **#
  435. #**                                                               **#
  436. #*******************************************************************#
  437. #*******************************************************************#
  438.  
  439.  
  440.                                 | entree:a7@(4) pointe sur n type IouR
  441.                                 | sortie:d0.l recoit le type de n
  442.  
  443. _typ:   moveq   #0,d0   
  444.         movb    sp@(4)@,d0
  445.         rts
  446.  
  447.                                 | entree:a7@(4) pointe sur n typeIouR
  448.                                 | a7@(8) contient le long t
  449.                                 | sortie:le type de la zone pointee
  450.                                 | par a7@(4) est force a t              
  451.  
  452. _settyp:movb    sp@(11),sp@(4)@
  453.         rts
  454.  
  455.                                 | entree:a7@(4) pointe sur P type pol ou ser
  456.                                 | sortie:d0.l recoit la variable de P
  457.  
  458. _varn:  moveq   #0,d0
  459.         movb    sp@(4)@(5),d0
  460.         rts
  461.  
  462.                                 | entree:a7@(4) pointe sur P type pol ou ser
  463.                                 | a7@(8) contient le long t <= 255
  464.                                 | sortie:la variable de P est mise a t.
  465.  
  466. _setvarn: movb  sp@(11),sp@(4)@(5)
  467.         rts
  468.  
  469.                                 | entree:a7@(4) pointe sur un type IouR
  470.                                 | a7@(8) contient un long i
  471.                                 | sortie:d0.l contient le ieme longmot
  472.                                 | de la mantisse de n
  473.  
  474. _mant:  movl    sp@(4),a0
  475.     tstb    a0@(4)
  476.     bne    1$
  477.     moveq    #0,d0
  478.     rts
  479. 1$:    movw    sp@(10),d0      | indice en mantisse
  480.         movl    a0@(4,d0:w:4),d0
  481.         rts
  482.  
  483.                                 | entree:a7@(4) pointe sur n type IouR
  484.                                 | a7@(8) contient un long i
  485.                                 | a7@(12) contient un long m
  486.                                 | sortie:le i-eme long mot de mantisse
  487.                                 | de n est force a m
  488.  
  489.  
  490. _setmant:movl   sp@(4),a0       | adresse du nombre
  491.         movw    sp@(10),d0      | indice en mantisse
  492.         lea     a0@(4,d0:w:4),a0
  493.         movl    sp@(12),a0@     | met nouveau lgmot de mantisse
  494.         rts
  495.  
  496.                                 | entree:a7@(4) pointe sur n type IouR
  497.                                 | sortie:d0.l contient longueur totale n
  498.  
  499. _lg:    moveq   #0,d0
  500.         movw    sp@(4)@(2),d0
  501.         rts
  502.  
  503.                                 | entree:a7@(4) pointe sur n type IouR
  504.                                 | a7@(8) contient un long l
  505.                                 | sortie:la longueur totale de n est
  506.                                 | forcee a l
  507.  
  508. _setlg: movw    sp@(10),sp@(4)@(2)
  509.         rts
  510.  
  511.                                 | entree:a7@(4) pointe sur n de type I
  512.                                 | sortie:d0.l contient long.effect.de n
  513.  
  514. _lgef:  moveq   #0,d0
  515.         movw    sp@(4)@(6),d0
  516.         rts
  517.  
  518.                                 | entree:a7@(4) pointe sur n de type I
  519.                                 | a7@(8) contient un long l
  520.                                 | sortie:la longueur effective de n est
  521.                                 | forcee a l
  522.  
  523. _setlgef:movw   sp@(10),sp@(4)@(6)
  524.         rts
  525.  
  526.                                 | entree:a7@(4) pointe sur n type IouR
  527.                                 | sortie:d0.l contient le signe de n
  528.  
  529. _signe: movb    sp@(4)@(4),d0   | octet numero 5 du gen
  530.         movb    sp@(4)@,d1      | type du gen
  531.         cmpb    #3,d1
  532.         bcs     1$
  533.         cmpb    #4,d1
  534.         beq     2$
  535.         cmpb    #5,d1
  536.         bne     1$
  537. 2$:     movl    sp@(4)@(4),a0   | ici fraction
  538.         movb    a0@(4),d0       | on renvoie le sgn du num !
  539. 1$:     extbl   d0
  540.         rts
  541.  
  542.                                 | entree:a7@(4) pointe sur n type IouR
  543.                                 | a7@(8) contient un long s
  544.                                 | sortie:le signe de n est force a s
  545.  
  546. _setsigne:movb  sp@(11),sp@(4)@(4)
  547.         rts
  548.  
  549.                                 | entree:a7@(4) pointe sur n type IouR
  550.                                 | sortie:d0.l contient nomb. peres de n
  551.  
  552. _pere:  moveq   #0,d0
  553.         movb    sp@(4)@(1),d0
  554.         rts
  555.  
  556.                                 | entree:a7@(4) pointe sur n type IouR
  557.                                 | a7@(8) contient un long s
  558.                                 | sortie:le nomb. peres de n est s
  559.  
  560. _setpere:movb   sp@(11),sp@(4)@(1)
  561.         rts
  562.  
  563.                                 | augmente de 1 le nombre de peres du
  564.                                 | IouR pointe par a7@(4)
  565.  
  566. _incpere:addqb  #1,sp@(4)@(1)
  567.         bne     1$
  568.         movb    #255,sp@(4)@(1)
  569. 1$:     rts
  570.  
  571.                                 | entree:a7@(4) pointe sur n de type R
  572.                                 | sortie:d0.l contient le vrai exposant de n
  573.  
  574. _expo:  movl    sp@(4)@(4),d0
  575.         andl    #0xffffff,d0
  576.         subl    #0x800000,d0
  577.         rts
  578.                                 | entree:a7@(4) pointe sur n de type I non nul
  579.                                 | sortie:d0.l contient l'exposant de n
  580.  
  581. _expi:  movl    sp@(4),a0
  582.         moveq   #0,d0
  583.         movw    a0@(6),d0
  584.         subql   #2,d0
  585.         lsll    #5,d0
  586.         movl    a0@(8),d1
  587.         bfffo   d1{#0:#0},d1
  588.     addql    #1,d1
  589.         subl    d1,d0
  590.         rts
  591.                                 | entree:a7@(4) pointe sur n de type R
  592.                                 | a7@(8) contient le long ex
  593.                                 | sortie:l'exposant de n est force a ex
  594.                                 | ou ex est le vrai exposant(non biaise)
  595.  
  596. _setexpo:movl   sp@(8),d0
  597.         addl    #0x800000,d0
  598.         movl    sp@(4),a0
  599.         movb    a0@(4),d1
  600.         movl    d0,a0@(4)
  601.         movb    d1,a0@(4)
  602.         rts
  603.  
  604.                                 | entree:a7@(4) pointe sur n de type p-adique
  605.                                 | ou serie.
  606.                                 | sortie:d0.l contient la valuation non biaisee
  607.  
  608. _valp:  moveq   #0,d0
  609.         movw    sp@(4)@(6),d0
  610.         subl    #0x8000,d0
  611.         rts
  612.  
  613.                                 | entree:a7@(4) pointe sur n de type p-adique
  614.                                 | ou serie. a7@(8) contient le long valp
  615.                                 | sortie:la valuation de n est
  616.                                 | forcee a valp.
  617.  
  618. _setvalp: movl  sp@(8),d0
  619.         addl    #0x8000,d0
  620.         movw    d0,sp@(4)@(6)
  621.         rts
  622.  
  623.                                 | entree:a7@(4) pointe sur n de type P
  624.                                 | sortie:d0.l contient la precision de n
  625.  
  626. _precp: moveq   #0,d0
  627.         movw    sp@(4)@(4),d0
  628.         rts
  629.  
  630.                                 | entree:a7@(4) pointe sur n de type P
  631.                                 | a7@(8) contient le long precp
  632.                                 | sortie:la precision de n est forcee
  633.                                 | a precp
  634.  
  635. _setprecp:movl  sp@(8),d0
  636.         movl    sp@(4),a0
  637.         movw    d0,a0@(4)
  638.         rts
  639.  
  640.  
  641.  
  642.  
  643.  
  644. #*******************************************************************#
  645. #*******************************************************************#
  646. #**                                                               **#
  647. #**             PROGRAMMES D'AFFECTATION OU D'ECHANGE             **#
  648. #**                                                               **#
  649. #*******************************************************************#
  650. #*******************************************************************#
  651.  
  652.  
  653.  
  654.  
  655.  
  656. #===================================================================#
  657. #                                                                   #
  658. #       Affectation generale    n2 --> n1                           #
  659. #                                                                   #
  660. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  661. #                a7@(8) pointe sur n1 de type I ou R                #
  662. #       sortie : la zone pointee par a7@(8) contient n2             #
  663. #       interdit : n2 ou n1 de type S                               #
  664. #       remarques: erreur dans le cas R --> I                       #
  665. #                  d0,d1,a0,a1 sont inchanges                       #
  666. #                                                                   #
  667. #===================================================================#
  668.  
  669. _mpaff: cmpb    #1,sp@(8)@
  670.         bne     1$
  671.                                 | ici T1 = I
  672.         cmpb    #1,sp@(4)@
  673.         beq     _affii          | ici T1 = T2 = I
  674.         bra     _affri          | ici T1 = I et T2 = R
  675.                                 | ici T1 = R
  676. 1$:     cmpb    #1,sp@(4)@
  677.         beq     _affir          | ici T1 = R et T2 = I
  678.         bra     _affrr          | ici T1 = T2 = R
  679.  
  680. #-------------------------------------------------------------------#
  681.  
  682.                                 | affectation s2 --> i1 ou r1
  683. _affsz: cmpb    #2,sp@(4)@
  684.         beq     _affsr
  685.                                 | affectation s2 --> i1
  686.  
  687. _affsi: link    a6,#0
  688.         moveml  d0/a0,sp@-
  689.         movl    a6@(8),d0       | d0.l contient s2
  690.         movl    a6@(12),a0      | a0 pointe sur i1
  691.         cmpw    #2,a0@(2)
  692.         bne     1$
  693.                                 | ici l1 = 2 (i1 = 0)
  694.         tstl    d0
  695.         beq     4$
  696.                                 | ici s2 <> 0 (erreur)
  697.         movl    #affer1,sp@-
  698.         jsr     _err
  699.                                 | ici s2 = 0 ou l1 >= 3
  700. 1$:     tstl    d0
  701. 4$:     bmi     2$
  702.                                 | ici s2 >= 0
  703.         bne     3$
  704.                                 | ici s2 = 0
  705.         movl    #2,a0@(4)
  706.         bra     affsif
  707.                                 | ici s2 > 0 et l1 >= 3
  708. 3$:     movl    #0x1000003,a0@(4)
  709.         movl    d0,a0@(8)
  710.         bra     affsif
  711.                                 | ici s2 < 0 et l1 >= 3
  712. 2$:     movl    #0xff000003,a0@(4)
  713.         negl    d0
  714.         movl    d0,a0@(8)
  715. affsif: moveml  sp@+,d0/a0
  716.         unlk    a6
  717.         rts
  718.  
  719. #-------------------------------------------------------------------#
  720.  
  721.                                 | affectation i2 --> i1
  722.  
  723. _affii: link    a6,#0
  724.         moveml  d0/a0-a1,sp@-
  725.         movl    a6@(8),a1       | a1 pointe sur i2
  726.         movl    a6@(12),a0      | a0 pointe sur i1
  727.         cmpl    a0,a1
  728.         beq     affiif
  729.                                 | ici a0 <> a1
  730.         movw    a0@(2),d0       | d0.w contient l1
  731.         cmpw    a1@(6),d0
  732.         bcc     1$
  733.                                 | ici le2 > l1 (erreur)
  734.         movl    #affer3,sp@-
  735.         jsr     _err
  736.                                 | ici le2 <= l1
  737. 1$:     movw    a1@(6),d0       | d0.w contient le2
  738.         subqw   #2,d0           | d0.w contient L2
  739.         addql   #4,a0
  740.         addql   #4,a1
  741.                                 | copie de i2 dans i1
  742. 2$:     movl    a1@+,a0@+
  743.         dbra    d0,2$
  744. affiif: moveml  sp@+,d0/a0-a1
  745.         unlk    a6
  746.         rts
  747.  
  748. #-------------------------------------------------------------------#
  749.  
  750.                                 | conversion i --> long du C dans d0
  751.  
  752. _itos:  movl    a1,sp@-
  753.         movl    sp@(8),a1       | a1 pointe sur i2
  754.         cmpw    #3,a1@(6)
  755.         bls     1$
  756.                                 | ici l2 >= 4 (erreur)
  757.         movl    #affer2,sp@-
  758.         jsr     _err
  759.                                 | ici l2 <= 3
  760. 1$:     beq     2$
  761.                                 | ici l2 = 2 (i2 = 0)
  762.         moveq   #0,d0
  763.         bra     itosf
  764.                                 | ici l2 = 3
  765. 2$:     movl    a1@(8),d0       | d0.l contient |i2|
  766.         cmpl    #0x80000000,d0
  767.         bcs     3$
  768.         beq     4$
  769.                                 | ici |i2| > 2^31 (erreur)
  770. 5$:     movl    #affer2,sp@-
  771.         jsr     _err
  772.                                 | ici |i2| = 2^31
  773. 4$:     tstb    a1@(4)
  774.         bpl     5$              | si i2 = 2^31 erreur
  775.         bra     itosf           | ici i2 = -2^31
  776.                                 | ici |i2| <= 2^31-1
  777. 3$:     tstw    a1@(4)
  778.         bpl     itosf
  779.         negl    d0
  780. itosf:  movl    sp@+,a1
  781.         rts
  782.  
  783. #-------------------------------------------------------------------#
  784.  
  785.                                 | conversion long du C --> i cree
  786.  
  787. _stoi:  movl    sp@(4),d1
  788.         bne     1$
  789.     movl    _gzero,d0
  790.     rts
  791. 1$:     movl    #3,d0
  792.         bsr     geti
  793.         tstl    d1
  794.         bmi     2$
  795.         movl    #0x1000003,a0@(4)
  796.         bra     3$
  797. 2$:     movl    #0xff000003,a0@(4)
  798.         negl    d1
  799. 3$:     movl    d1,a0@(8)
  800.     movl    a0,d0
  801.         rts
  802.  
  803. #-----------------------------------------------------------------------#
  804.  
  805.                                 | affectation s2 --> r1
  806.  
  807. _affsr: link    a6,#0
  808.         moveml  d0-d1/a0,sp@-
  809.         movl    a6@(12),a0      | a0 pointe sur r1
  810.         movl    a6@(8),d0       | d0.l contient s2
  811.         bne     1$
  812.                                 | ici s2 = 0
  813.         moveq   #0,d0
  814.         movw    a0@(2),d0
  815.         subqw   #2,d0
  816.         lsll    #5,d0
  817.         negl    d0
  818.         addl    #0x800000,d0    | d0.l contient fexp(0)
  819.         movl    d0,a0@(4)
  820.         clrl    a0@(8)
  821.         bra     affsrf
  822.                                 | ici s2 <> 0
  823. 1$:     bpl     2$
  824.         negl    d0
  825.         movb    #0xff,a0@(4)    | mise signe si s2 < 0
  826.         bra     3$
  827. 2$:     movb    #1,a0@(4)       | mise signe si s2 > 0
  828.                                 | ici s2 <> 0
  829. 3$:     bfffo   d0{#0:#0},d1    | d1.l recoit nb. de shifts (=k)
  830.         lsll    d1,d0           | d0.l est norme
  831.         negw    d1
  832.         addw    #31,d1
  833.         movw    d1,a0@(6)
  834.         movb    #0x80,a0@(5)    | mise exposant
  835.         movl    d0,a0@(8)       | mise 1er long mot mantisse
  836.         moveq   #0,d0
  837.         movw    a0@(2),d1
  838.         subql   #3,d1           | d1.w recoit L1-1
  839.         addl    #12,a0          | a0 pointe sur 2eme long mot mantisse
  840.         bra     4$
  841. 5$:     movl    d0,a0@+
  842. 4$:     dbra    d1,5$
  843. affsrf: moveml  sp@+,d0-d1/a0
  844.         unlk    a6
  845.         rts
  846.  
  847. #-------------------------------------------------------------------#
  848.  
  849.                                 | affectation i2 --> r1
  850.  
  851. _affir: link a6,#0
  852.         moveml  d0-d6/a0-a1,sp@-
  853.         movl    a6@(8),a1       | a1 pointe sur i2
  854.         movl    a6@(12),a0      | a0 pointe sur r1
  855.         tstb    a1@(4)
  856.         bne     1$
  857.                                 | ici i2 = 0
  858.         moveq   #0,d0
  859.         movw    a0@(2),d0
  860.         subqw   #2,d0
  861.         lsll    #5,d0
  862.         negl    d0
  863.         addl    #0x800000,d0
  864.         movl    d0,a0@(4)
  865.         clrl    a0@(8)
  866.         bra     affirf
  867.                                 | ici i2 <> 0
  868. 1$:     movl    a1@(8),d0       | d0.l contient 1er lg mot mantisse
  869.         bfffo   d0{#0:#0},d1    | d1.l recoit nb de shifts (=k)
  870.         lsll    d1,d0           | d0.l normalise
  871.         moveq   #0,d2
  872.         movw    a1@(6),d2
  873.         lsll    #5,d2
  874.         subl    d1,d2
  875.         addl    #0x7fffbf,d2    | d2.l = fexp2 = 2^23 + L1*32 -1 -k
  876.         movl    d2,a0@(4)       | mise exposant
  877.         movb    a1@(4),a0@(4)   | mise signe
  878.         movw    a1@(6),d4
  879.         subqw   #3,d4           | d4.w recoit L2-1 (compteur)
  880.         movw    a0@(2),d2
  881.         subqw   #3,d2           | d2.w recoit L1-1
  882.         addl    #12,a1          | a1 pointe sur 2eme lg mot mantisse i2
  883.         addql   #8,a0           | a0 ponte sur 1er lg mot mantisse r1
  884.         moveq   #1,d6           | masque
  885.         lsll    d1,d6
  886.         subql   #1,d6
  887.         subw    d4,d2           | d2.w  recoit L1-L2
  888.         bpl     2$
  889.                                 | ici L1 < L2
  890.         addw    d2,d4           | d4.w  recoit L1-1
  891.         bra     2$
  892.                                 | copie mantisse shiftee dans r1
  893. 3$:     movl    a1@+,d3
  894.         roll    d1,d3
  895.         movl    d3,d5
  896.         andl    d6,d3
  897.         addl    d3,d0
  898.         movl    d0,a0@+
  899.         subl    d3,d5
  900.         movl    d5,d0
  901. 2$:     dbra    d4,3$
  902.         tstw    d2
  903.         bmi     4$
  904.                                 | ici L1 > L2 completer par des 0
  905.         moveq   #0,d3
  906.         movl    d0,a0@+
  907.         bra     5$
  908. 6$:     movl    d3,a0@+
  909. 5$:     dbra    d2,6$
  910.         bra     affirf
  911.                                 | ici L1 <= L2
  912. 4$:     movl    a1@+,d3
  913.         roll    d1,d3
  914.         andl    d6,d3
  915.         addl    d3,d0
  916.         movl    d0,a0@+         | mise a jour dernier lg mot
  917. affirf: moveml  sp@+,d0-d6/a0-a1
  918.         unlk    a6
  919.         rts
  920.  
  921. #-------------------------------------------------------------------#
  922.  
  923.                                 | affectation r2 --> r1
  924.  
  925. _affrr: link    a6,#0
  926.         moveml  d0-d1/a0-a1,sp@-
  927.         movl    a6@(8),a1       | a1 pointe sur r2
  928.         movl    a6@(12),a0      | a0 pointe sur r1
  929.         cmpl    a0,a1
  930.         beq     affrrf
  931.                                 | ici a0 <> a1
  932.         tstb    a1@(4)
  933.         bne     6$              
  934.                                 | ici r2 = 0
  935.         movl    a1@(4),a0@(4)
  936.         clrl    a0@(8)
  937.         bra     affrrf
  938.                                 | ici r2 <> 0
  939. 6$:     addql   #4,a0
  940.         addql   #4,a1
  941.         movw    a0@(-2),d0
  942.         movw    a1@(-2),d1      | d0.w , d1.w contient l1,l2
  943.         cmpw    d0,d1
  944.         bhi     1$
  945.                                 | ici l1 >= l2
  946.         subw    d1,d0           | d0.w contient l1-l2
  947.         subqw   #2,d1           | d1.w  contient L2
  948. 3$:     movl    a1@+,a0@+       | copie de r2 dans r1
  949.         dbra    d1,3$
  950.         moveq   #0,d1
  951.         bra     2$
  952.                                 | ici completer par des 0
  953. 4$:     movl    d1,a0@+
  954. 2$:     dbra    d0,4$
  955.         bra     affrrf
  956.                                 | ici l2 > l1
  957. 1$:     subqw   #2,d0           | d0.w recoit L1 (compteur)
  958. 5$:     movl    a1@+,a0@+
  959.         dbra    d0,5$
  960. affrrf: moveml  sp@+,d0-d1/a0-a1
  961.         unlk    a6
  962.         rts
  963.  
  964. #-------------------------------------------------------------------#
  965.  
  966.                                 | affectation r2 --> s1
  967.  
  968. _affrs: movl    #affer4,sp@-
  969.         jsr     _err
  970.  
  971. #-------------------------------------------------------------------#
  972.  
  973.                                 | affectation r2 --> i1
  974.  
  975. _affri: movl    #affer5,sp@-
  976.         jsr     _err
  977.  
  978. #===================================================================#
  979. #                                                                   #
  980. #                       Echange de deux nombres                     #
  981. #                                                                   #
  982. #       entree : a7@(4) contient l'adresse d'une zone z2 contemant  #
  983. #                n2 de type I ou R ; a7@(8) contient l'adresse d'une#
  984. #                zone z1 contenant n1 de type I ou R                #
  985. #       sortie : a7@(4) contient l'adresse de z2 contenant n1       #
  986. #                a7@(8) contient l'adresse de z1 contenant n2       #
  987. #                d0,d1,a0,a1 sont sauvegardes                       #
  988. #       remarque : message d'erreur si impossible ; type S interdit #
  989. #                                                                   #
  990. #===================================================================#
  991.  
  992. _mpexg: link    a6,#0
  993.         moveml  d0-d4/a0-a2,sp@-
  994.         movl    a6@(8),a2       | a2 pointe sur n2
  995.         movl    a6@(12),a1      | a1 pointe sur n1
  996.         movb    a2@,d2
  997.         movb    a1@,d1          | d1.b et d2.b contiennent T1 et T2
  998.         cmpb    d1,d2
  999.         beq     1$
  1000.                                 | ici T1 <> T2 (erreur)
  1001.         movl    #exger2,sp@-
  1002.         jsr     _err
  1003.                                 | ici T1 = T2
  1004. 1$:     movl    a1@,d3          | d3.l contient le 1er lgmot code de n1
  1005.         movl    a2@,d4          | d4.l contient le 1er lgmot code de n2
  1006.         cmpw    d3,d4
  1007.         bne     2$
  1008.                                 | ici T1 = T2 et l1 = l2
  1009.         subqw   #3,d3
  1010.         addql   #4,a1
  1011.         addql   #4,a2
  1012. 6$:     movl    a2@,d4
  1013.         movl    a1@,a2@+
  1014.         movl    d4,a1@+
  1015.         dbra    d3,6$
  1016.         bra     exgf
  1017.                                 | ici T1 = T2 et l1 <> l2
  1018. 2$:     cmpb    #1,d1
  1019.         bne     3$
  1020.                                 | ici T1 = T2 = I et l1 <> l2
  1021.         cmpw    d3,d4
  1022.         ble     4$
  1023.         exg     a1,a2           | si l2 > l1 echanger n1 et n2
  1024.         exg     d3,d4
  1025.                                 | ici l2 <= l1
  1026. 4$:     cmpw    a1@(6),d4
  1027.         bpl     5$
  1028.                                 | ici l2 < le1 (erreur)
  1029.         movl    #exger1,sp@-
  1030.         jsr     _err
  1031.                                 | ici l2 >= le1
  1032. 5$:     movl    d4,d0
  1033.         bsr     geti            | allocation memoire pour copie de n2
  1034.         movl    a0,sp@-         | empilage adresse copie
  1035.         movl    a2,sp@-         | empilage adresse de n2
  1036.         bsr     _affii
  1037.         addql   #8,sp           | depilage
  1038.         movl    a2,sp@-         | empilage adresse n2
  1039.         movl    a1,sp@-         | empilage adresse n1
  1040.         bsr     _affii
  1041.         addql   #8,sp           | depilage
  1042.         movl    a1,sp@-         | empilage adresse n1
  1043.         movl    a0,sp@-         | empilage adresse copie
  1044.         bsr     _affii
  1045.         addql   #8,sp           | depilage
  1046.         bsr     giv             | desallouer copie
  1047.         bra     exgf
  1048.                                 | ici T1 = T2 = R et l1 <> l2
  1049. 3$:     movl    d4,d0
  1050.         bsr     getr            | allocation memoire pour copie de n2
  1051.         movl    a0,sp@-         | empilage adresse copie
  1052.         movl    a2,sp@-         | empilage adresse n2
  1053.         bsr     _affrr
  1054.         addql   #8,sp
  1055.         movl    a2,sp@-         | empilage adresse n2
  1056.         movl    a1,sp@-         | empilage adresse n1
  1057.         bsr     _affrr
  1058.         addql   #8,sp
  1059.         movl    a1,sp@-         | empilage adresse n1
  1060.         movl    a0,sp@-         | empilage adresse copie
  1061.         bsr     _affrr
  1062.         addql   #8,sp
  1063.         bsr     giv             | desallouer copie
  1064. exgf:   moveml  sp@+,d0-d4/a0-a2
  1065.         unlk    a6
  1066.         rts
  1067.  
  1068.  
  1069.  
  1070.  
  1071.  
  1072. #*******************************************************************#
  1073. #*******************************************************************#
  1074. #**                                                               **#
  1075. #**             PROGRAMMES DE CHANGEMENT DE SIGNE                 **#
  1076. #**                                                               **#
  1077. #*******************************************************************#
  1078. #*******************************************************************#
  1079.  
  1080.  
  1081.  
  1082.  
  1083.  
  1084. #===================================================================#
  1085. #                                                                   #
  1086. #                       Negation generale                           #
  1087. #                                                                   #
  1088. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1089. #       sortie : d0 pointe sur n1 de type I ou R                    #
  1090. #                contenant n1 = -n2 (zone creee)                    #
  1091. #       interdit : type S                                           #
  1092. #                                                                   #
  1093. #===================================================================#
  1094.  
  1095. _mpneg: cmpb    #1,sp@(4)@
  1096.         beq     _negi
  1097.         bra     _negr
  1098.  
  1099. #===================================================================#
  1100. #                                                                   #
  1101. #                       Negation (par valeur)                       #
  1102. #                                                                   #
  1103. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1104. #                a7@(8) pointe sur n1 de type I ou R                #
  1105. #       sortie : la zone pointee par a7@(8) contient -n2            #
  1106. #       interdit : type S                                           #
  1107. #                                                                   #
  1108. #===================================================================#
  1109.  
  1110. _mpnegz:movl    sp@(4),a0
  1111.         cmpl    sp@(8),a0
  1112.         bne     1$
  1113.         negb    a0@(4)
  1114.         rts
  1115. 1$:     movl    sp@(4),sp@-
  1116.         bsr     _mpneg
  1117.         movl    d0,sp@-
  1118.         movl    sp@(16),sp@(4)
  1119.         bsr     _mpaff
  1120.         movl    sp@,a0
  1121.         addql   #8,sp
  1122.         bra     giv
  1123.  
  1124. #===================================================================#
  1125. #                                                                   #
  1126. #                       Negation                                    #
  1127. #                                                                   #
  1128. #       entree : a7@(4) contient un type S ou pointe sur un         #
  1129. #                type I ou R , soit n2                              #
  1130. #       sortie : d0 pointe sur un type I ou R ,soit n1=-n2          #
  1131. #                (zone creee)                                       #
  1132. #                                                                   #
  1133. #===================================================================#
  1134.  
  1135.                                 | negation s2 --> i1
  1136.  
  1137. _negs:  movl    sp@(4),d1       | d1.l recoit s2
  1138.         bne     1$
  1139.                                 | ici s2 = 0
  1140.         movl    _gzero,d0
  1141.     rts
  1142.                                 | ici s2 <> 0
  1143. 1$:     moveq   #3,d0
  1144.         bsr     geti            | allocation 3 longs mots
  1145.         movl    a0,d0           | d0 pointe sur resultat
  1146.         movl    #0x1000003,a0@(4)
  1147.         negl    d1
  1148.         bpl     2$
  1149.                                 | ici s2 < 0
  1150.         movb    #0xff,a0@(4)
  1151.         negl    d1
  1152. 2$:     movl    d1,a0@(8)
  1153.     rts
  1154.  
  1155. #-------------------------------------------------------------------#
  1156.  
  1157.                                 | negation i2 --> i1
  1158.  
  1159. _negi:  movl    sp@(4),a1       | a1 pointe sur i2
  1160.         movw    a1@(6),d1
  1161.         movl    d1,d0
  1162.         bsr     geti
  1163.         movl    a0,d0           | d0 pointe sur -i2
  1164.         addql   #4,a0
  1165.         addql   #4,a1
  1166.         subqw   #2,d1
  1167.                                 | recopie de i2
  1168. 1$:     movl    a1@+,a0@+
  1169.         dbra    d1,1$
  1170.         movl    d0,a0
  1171.         negb    a0@(4)
  1172.         rts
  1173.  
  1174. #-------------------------------------------------------------------#
  1175.  
  1176.                                 | negation r2 --> r1
  1177.  
  1178. _negr:  movl    sp@(4),a1
  1179.         movl    a1@,d1
  1180.         movl    d1,d0
  1181.         bsr     getr
  1182.         movl    a0,d0
  1183.         addql   #4,a0
  1184.         addql   #4,a1
  1185.         subqw   #2,d1
  1186. 1$:     movl    a1@+,a0@+
  1187.         dbra    d1,1$
  1188.         movl    d0,a0
  1189.         negb    a0@(4)
  1190.         rts
  1191.  
  1192. #===================================================================#
  1193. #                                                                   #
  1194. #                       Valeur absolue generale                     #
  1195. #                                                                   #
  1196. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1197. #       sortie : d0 pointe sur n1 de type I ou R avec n1=abs(n2)    #
  1198. #                de type I ou R (zone creee)                        #
  1199. #       interdit : type S                                           #
  1200. #                                                                   #
  1201. #===================================================================#
  1202.  
  1203. _mpabs: cmpb    #1,sp@(4)@
  1204.         beq     _absi
  1205.         bra     _absr
  1206.  
  1207. #===================================================================#
  1208. #                                                                   #
  1209. #                       Valeur absolue (par valeur)                 #
  1210. #                                                                   #
  1211. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1212. #                a7@(8) pointe sur n1 de type I ou R                #
  1213. #       sortie : la zone pointee par a7@(8) contient abs(n2)        #
  1214. #       interdit : type S                                           #
  1215. #                                                                   #
  1216. #===================================================================#
  1217.  
  1218. _mpabsz:movl    sp@(4),a0
  1219.         cmpl    sp@(8),a0
  1220.         bne     1$
  1221.         andb    #1,a0@(4)
  1222.         rts
  1223. 1$:     movl    sp@(4),sp@-
  1224.         bsr     _mpabs
  1225.         movl    d0,sp@-
  1226.         movl    sp@(16),sp@(4)
  1227.         bsr     _mpaff
  1228.         movl    sp@,a0
  1229.         addql   #8,sp
  1230.         bra     giv
  1231.  
  1232. #===================================================================#
  1233. #                                                                   #
  1234. #                       Valeur absolue                              #
  1235. #                                                                   #
  1236. #       entree : a7@(4) contient ou pointe sur n2                   #
  1237. #       sortie : d0 pointe sur i1 ou r1 (zone creee)                #
  1238. #                                                                   #
  1239. #===================================================================#
  1240.  
  1241.                                 | valeur absolue s2 --> i1
  1242.  
  1243. _abss:  movl    sp@(4),d1       | d1.l contient s2
  1244.         bne     1$
  1245.                                 | ici s2 = 0
  1246.     movl    _gzero,d0
  1247.     rts
  1248.                                 | ici s2 <> 0
  1249. 1$:     moveq   #3,d0
  1250.         bsr     geti
  1251.         movl    a0,d0
  1252.         movl    #0x1000003,a0@(4)
  1253.         tstl    d1
  1254.         bpl     2$
  1255.         negl    d1
  1256. 2$:     movl    d1,a0@(8)
  1257.         rts
  1258.  
  1259. #-------------------------------------------------------------------#
  1260.  
  1261.                                 | valeur absolue i2 --> i1
  1262.  
  1263. _absi:  movl    sp@(4),a1       | a1 pointe sur i2
  1264.         movw    a1@(6),d1
  1265.         movw    d1,d0
  1266.         bsr     geti
  1267.         movl    a0,d0           | d0 pointe sur resultat
  1268.         cmpw    #2,d1
  1269.         bne     1$
  1270.                                 | ici i2 = 0
  1271.         movl    #2,a0@(4)
  1272.         bra     absif
  1273.                                 | ici i2 <> 0
  1274. 1$:     movl    #0x1000000,a0@(4)
  1275.         movw    d1,a0@(6)
  1276.         addql   #8,a1
  1277.         addql   #8,a0
  1278.         subqw   #3,d1
  1279. 2$:     movl    a1@+,a0@+
  1280.         dbra    d1,2$
  1281. absif:  rts
  1282.  
  1283. #-------------------------------------------------------------------#
  1284.  
  1285.                                 | valeur absolue r2 --> r1
  1286.  
  1287. _absr:  movl    sp@(4),a1
  1288.         movw    a1@(2),d1
  1289.         movw    d1,d0
  1290.         bsr     getr
  1291.         movl    a0,d0           | a0 pointe sur resultat
  1292.         subqw   #2,d1
  1293.         addql   #4,a1
  1294.         addql   #4,a0
  1295. 1$:     movl    a1@+,a0@+
  1296.         dbra    d1,1$
  1297.         movl    d0,a0
  1298.         tstb    a0@(4)
  1299.         bpl     absrf
  1300.         negb    a0@(4)
  1301. absrf:  rts
  1302.  
  1303. #*******************************************************************#
  1304. #*******************************************************************#
  1305. #**                                                               **#
  1306. #**                     VALUATION                                 **#
  1307. #**                                                               **#
  1308. #*******************************************************************#
  1309. #*******************************************************************#
  1310.  
  1311.  
  1312.  
  1313.  
  1314.  
  1315. #===================================================================#
  1316. #                                                                   #
  1317. #       Valuation 2-adique d'un entier court ou d'un entier         #
  1318. #                                                                   #
  1319. #       entree : a7@(4) contient s1 de type S ou pointe sur i1 de   #
  1320. #                type I                                             #
  1321. #       sortie : d0.l contient k tel que : k>=0 , n1=2^k*n2 ,       #
  1322. #                avec n2 et 2 premiers entre eux ; si n1=0 , alors  #
  1323. #                d0.l contient -1.                                  #
  1324. #       remarque : type R interdit                                  #
  1325. #                                                                   #
  1326. #===================================================================#
  1327.  
  1328.                                 | valuation de s1 de type S
  1329.  
  1330. _vals:  link    a6,#0
  1331.         movl    d2,sp@-
  1332.         moveq   #-1,d0
  1333.         movl    a6@(8),d1       | d1.l contient s1
  1334.         beq     valsf
  1335.         moveq   #0,d0
  1336.         tstw    d1
  1337.         bne     1$
  1338.         addl    #16,d0
  1339.         swap    d1
  1340. 1$:     tstb    d1
  1341.         bne     2$
  1342.         addql   #8,d0
  1343.         lsrl    #8,d1
  1344. 2$:     movl    d1,d2
  1345.         andl    #15,d2
  1346.         bne     3$
  1347.         addql   #4,d0
  1348.         lsrl    #4,d1
  1349. 3$:     movl    d1,d2
  1350.         andl    #3,d2
  1351.         bne     4$
  1352.         addql   #2,d0
  1353.         lsrl    #2,d1
  1354. 4$:     btst    #0,d1
  1355.         bne     valsf
  1356.         addql   #1,d0
  1357. valsf:  movl    sp@,d2
  1358.         unlk    a6
  1359.         rts
  1360.  
  1361.                                 | valuation de i1 de type I
  1362.  
  1363. _vali:  link    a6,#0
  1364.         movl    d2,sp@-
  1365.         movl    a6@(8),a1       | a1 pointe sur i1
  1366.         moveq   #-1,d0
  1367.         tstb    a1@(4)
  1368.         beq     valif
  1369.                                 | ici i1 <> 0
  1370.         movw    a1@(6),d1       | d1.w contient L1+2
  1371.         lea     a1@(0,d1:w:4),a1| a1 pointe fin mantisse de i1
  1372.         movl    #0xffff,d0
  1373. 5$:     tstl    a1@-
  1374.         dbne    d0,5$
  1375.         notw    d0
  1376.         lsll    #5,d0           | d0.l contient 32*nb.de lgmots nuls
  1377.         movl    a1@,d1          | a droite de i1 et a1 pointe 1er lgmot
  1378.         tstw    d1              | non nul (qui existe car i1 <> 0)
  1379.         bne     1$
  1380.         addl    #16,d0
  1381.         swap    d1
  1382. 1$:     tstb    d1
  1383.         bne     2$
  1384.         addql   #8,d0
  1385.         lsrl    #8,d1
  1386. 2$:     movl    d1,d2
  1387.         andl    #15,d2
  1388.         bne     3$
  1389.         addql   #4,d0
  1390.         lsrl    #4,d1
  1391. 3$:     movl    d1,d2
  1392.         andl    #3,d2
  1393.         bne     4$
  1394.         addql   #2,d0
  1395.         lsrl    #2,d1
  1396. 4$:     btst    #0,d1
  1397.         bne     valif
  1398.         addql   #1,d0
  1399. valif:  movl    sp@,d2
  1400.         unlk    a6
  1401.         rts
  1402.  
  1403.  
  1404.  
  1405.  
  1406.  
  1407. #*******************************************************************#
  1408. #*******************************************************************#
  1409. #**                                                               **#
  1410. #**                     PROGRAMMES DE SHIFT                       **#
  1411. #**                                                               **#
  1412. #*******************************************************************#
  1413. #*******************************************************************#
  1414.  
  1415.  
  1416.  
  1417.  
  1418.  
  1419. #===================================================================#
  1420. #                                                                   #
  1421. #                       Shift general                               #
  1422. #                                                                   #
  1423. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1424. #                a7@(8) contient k = nombre de shifts               #
  1425. #       sortie : d0 pointe sur n1 de type I ou R                    #
  1426. #                contenant n1 = 2^k * n2 (zone creee)               #
  1427. #       interdit : type S                                           #
  1428. #                                                                   #
  1429. #===================================================================#
  1430.  
  1431. _mpshift:cmpb   #1,sp@(4)@
  1432.         beq     _shifti
  1433.         bra     _shiftr
  1434.  
  1435. #===================================================================#
  1436. #                                                                   #
  1437. #                       Shift (par valeur)                          #
  1438. #                                                                   #
  1439. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1440. #                a7@(8) contient le nombre de shifts (=k)           #
  1441. #                a7@(12) pointe sur n1 de type I ou R               #
  1442. #       sortie : la zone pointee par a7@(12) contient 2^k * n2      #
  1443. #       interdit : type S                                           #
  1444. #                                                                   #
  1445. #===================================================================#
  1446.  
  1447. _mpshiftz:movl  sp@(4),a0
  1448.         cmpl    sp@(12),a0
  1449.         bne     1$
  1450.         cmpb    #2,a0@
  1451.         bne     1$
  1452.         movl    a0@(4),d0
  1453.         andl    #0xffffff,d0
  1454.         addl    sp@(8),d0
  1455.         bvs     shier
  1456.         cmpl    #0x1000000,d0
  1457.         bcc     shier
  1458.         tstl    d0
  1459.         bmi     shier
  1460.         movw    d0,a0@(6)
  1461.         swap    d0
  1462.         movb    d0,a0@(5)
  1463.         rts
  1464. 1$:     movl    sp@(8),sp@-
  1465.         movl    sp@(8),sp@-
  1466.         bsr     _mpshift
  1467.         movl    d0,sp@
  1468.         movl    sp@(20),sp@(4)
  1469.         bsr     _mpaff
  1470.         movl    sp@,a0
  1471.         addql   #8,sp
  1472.         bra     giv
  1473.  
  1474. #===================================================================#
  1475. #                                                                   #
  1476. #               Shift d'un entier court = entier                    #
  1477. #                                                                   #
  1478. #       entree : a7@(4) contient s2 de type S                       #
  1479. #                a7@(8) contient k = nombre de shifts               #
  1480. #       sortie : d0 pointe sur i1 de type I                         #
  1481. #                avec i1 = 2^k * s2 (zone creee)                    #
  1482. #                                                                   #
  1483. #===================================================================#
  1484.  
  1485. _shifts:link    a6,#-12
  1486.         movl    a6@(12),sp@-    | empilage k
  1487.         movl    a6@(8),d0       | d0.l contient s2
  1488.         bne     1$
  1489.                                 | ici s2 = 0
  1490.         movl    #0x1000002,a6@(-12)
  1491.         movl    #2,a6@(-8)      | creation de 0 en var. locale
  1492.         bra     3$
  1493.                                 | ici s2 <> 0
  1494. 1$:     movl    #0x1000003,a6@(-12)
  1495.         movl    #0x1000003,a6@(-8)
  1496.         tstl    d0
  1497.         bpl     2$
  1498.         negl    d0
  1499.         movb    #0xff,a6@(-8)
  1500. 2$:     movl    d0,a6@(-4)      | creation de s2 en var. locale
  1501. 3$:     pea     a6@(-12)        | empilage adresse var. locale
  1502.         bsr     _shifti
  1503.         unlk    a6
  1504.         rts
  1505.  
  1506. #===================================================================#
  1507. #                                                                   #
  1508. #                       Shift entier = entier                       #
  1509. #                                                                   #
  1510. #       entree : a7@(4) pointe sur i2 de type I                     #
  1511. #                a7@(8) contient k = nombre de shifts               #
  1512. #       sortie : d0 pointe sur i1 de type I                         #
  1513. #                avec i1 = 2^k * i2 (zone creee)                    #
  1514. #                                                                   #
  1515. #===================================================================#
  1516.  
  1517. _shifti:link    a6,#0
  1518.         moveml  d2-d7/a2-a3,sp@-
  1519.         movl    a6@(8),a2       | a2 pointe sur i2
  1520.         movl    a6@(12),d7      | d7.l contient k
  1521.         bne     1$
  1522.                                 | ici k = 0
  1523.         movw    a2@(2),d0
  1524.         bsr     geti
  1525.         movl    a0,a3   | sauvegarde adresse resultat
  1526.         subqw   #2,d0
  1527.         addql   #4,a0
  1528.         addql   #4,a2
  1529. 24$:    movl    a2@+,a0@+
  1530.         dbra    d0,24$
  1531.         bra     shiftif
  1532.                                 | ici k <> 0
  1533. 1$:     tstb    a2@(4)
  1534.         bne     2$
  1535.                                 | ici i1 = 0
  1536. 6$:     movl    _gzero,d0       | sauvegarde adresse resultat
  1537.         bra     shiftig
  1538.                                 | ici k <> 0 et i2 <> 0
  1539. 2$:     moveq   #0,d0
  1540.         movw    a2@(6),d0       | d0.w contient L2+2
  1541.         cmpl    #1,d7
  1542.         bne     3$
  1543.                                 | ici k = 1 et i2 <> 0
  1544.         movl    a2@(8),d5
  1545.         btst    #31,d5
  1546.         beq     4$
  1547.                                 | ici d5 >= 2^31
  1548.         addqw   #1,d0           | demander 1 lgmot supplementaire
  1549.         cmpw    #0x8000,d0
  1550.         bcs     4$
  1551.                                 | ici debordement
  1552. 18$:    movl    #shier1,sp@-
  1553.         jsr     _err
  1554.                                 | ici k = 1 et i2 <> 0
  1555. 4$:     bsr     geti
  1556.         movl    a0,a3           | sauvegarde adresse resultat
  1557.         movw    a0@(2),a0@(6)   | mise longueur effective
  1558.         movb    a2@(4),a0@(4)   | mise signe
  1559.         lea     a0@(0,d0:w:4),a1| a1 pointe fin resultat
  1560.         lea     a2@(0,d0:w:4),a2
  1561.         btst    #31,d5
  1562.         beq     5$
  1563.         subqw   #4,a2           | ici a2 pointe fin i2
  1564.         movl    #1,a0@(8)
  1565.         subqw   #1,d0
  1566. 5$:     subqw   #3,d0           | d0.w compteur
  1567. 7$:     movl    a2@-,d1
  1568.         roxll   #1,d1
  1569.         movl    d1,a1@-
  1570.         dbra    d0,7$
  1571.         bra     shiftif
  1572.                                 | ici k <> 1 et i2 <> 0
  1573. 3$:     cmpl    #-1,d7
  1574.         bne     8$
  1575.                                 | ici k = -1 et i2 <> 0
  1576.         cmpl    #1,a2@(8)
  1577.         bhi     9$
  1578.         subqw   #1,d0
  1579.         cmpw    #2,d0
  1580.         beq     6$              | si i1 = 0
  1581. 9$:     bsr     geti
  1582.         movl    a0,a3
  1583.         movb    a2@(4),a0@(4)   | mise signe
  1584.         movw    a0@(2),a0@(6)   | mise longueur effective
  1585.         addql   #8,a0
  1586.         addql   #8,a2
  1587.         movw    a2@(-2),d0
  1588.         subqw   #3,d0           | d0.w compteur
  1589.         movl    a2@+,d1
  1590.         lsrl    #1,d1
  1591.         beq     10$
  1592.         movl    d1,a0@+
  1593.         bra     10$
  1594. 11$:    movl    a2@+,d1
  1595.         roxrl   #1,d1
  1596.         movl    d1,a0@+
  1597. 10$:    dbra    d0,11$
  1598.         bra     shiftif
  1599.                                 | ici k<>0,k<>1,k<>-1 et i2<>0
  1600. 8$:     tstl    d7
  1601.         bpl     12$
  1602.                                 | ici shift a droite : k < -1 et i2 <> 0
  1603.         negl    d7              | d7.l contient /k/
  1604.         movl    d7,d4
  1605.         lsrl    #5,d4           | d4.l contient r
  1606.         andl    #31,d7          | k=32*q+r; d7.l contient q
  1607.         subw    d4,d0           | d0.w contient L2+2-q
  1608.         cmpw    #2,d0
  1609.         bls     2$              | si r1 = 0
  1610.         movl    a2@(8),d4
  1611.         lsrl    d7,d4
  1612.         bne     13$
  1613.                                 | ici on perd un lgmot de resultat
  1614.         subqw   #1,d0
  1615.         cmpw    #2,d0
  1616.         beq     6$              | si r1 = 0
  1617. 13$:    bsr     geti            | allocation memoire pour resultat
  1618.         movl    a0,a3
  1619.         movb    a2@(4),a0@(4)   | mise signe
  1620.         movw    a0@(2),a0@(6)   | mise longueur effective
  1621.         lea     a2@(0,d0:w:4),a2| a2 pointe ou il faut !
  1622.         lea     a0@(0,d0:w:4),a1| a1 pointe fin resultat
  1623.         tstl    d4
  1624.         beq     14$
  1625.         movl    d4,a0@(8)
  1626.         subqw   #3,d0           | d0.w compteur
  1627.         bra     15$
  1628. 14$:    addql   #4,a2
  1629.         subqw   #2,d0
  1630. 15$:    moveq   #-1,d6
  1631.         lsrl    d7,d6           | masque de shift
  1632.         movl    a2@-,d4
  1633.         lsrl    d7,d4
  1634.         bra     16$
  1635. 17$:    movl    a2@-,d2         | boucle de shift
  1636.         rorl    d7,d2
  1637.         movl    d2,d3
  1638.         andl    d6,d3
  1639.         subl    d3,d2
  1640.         addl    d2,d4
  1641.         movl    d4,a1@-
  1642.         movl    d3,d4
  1643. 16$:    dbra    d0,17$
  1644.         bra     shiftif
  1645.                                 | ici shift a gauche : k > 1 et i2 <> 0
  1646. 12$:    movl    d7,d4
  1647.         andl    #31,d7          | d7.l contient q
  1648.         lsrl    #5,d4           | d4.l contient r (k=32*q+r)
  1649.         addl    d4,d0           | d0.l contient L2+2+q
  1650.         cmpw    #0x7fff,d0
  1651.         bcc     18$
  1652.         moveq   #-1,d6
  1653.         lsll    d7,d6
  1654.         notl    d6              | masque de shift
  1655.         movl    a2@(8),d2
  1656.         roll    d7,d2
  1657.         movl    d2,d3
  1658.         andl    d6,d3
  1659.         beq     19$
  1660.         addqw   #1,d0           | un long mot supplementaire
  1661. 19$:    bsr     geti
  1662.         movl    a0,a3
  1663.         movl    a0@(2),a0@(6)   | mise longueur effective
  1664.         movb    a2@(4),a0@(4)   | mise signe
  1665.         addql   #8,a0
  1666.         tstl    d3
  1667.         beq     20$
  1668.         movl    d3,a0@+
  1669. 20$:    subl    d3,d2
  1670.         movl    d2,d5
  1671.         movw    a2@(6),d0
  1672.         addl    #12,a2
  1673.         subqw   #3,d0           | d0.w contient compteur
  1674.         bra     21$
  1675. 22$:    movl    a2@+,d2
  1676.         roll    d7,d2
  1677.         movl    d2,d3
  1678.         andl    d6,d3
  1679.         subl    d3,d2
  1680.         addl    d3,d5
  1681.         movl    d5,a0@+
  1682.         movl    d2,d5
  1683. 21$:    dbra    d0,22$
  1684.         movl    d5,a0@+
  1685.         moveq   #0,d0
  1686.         bra     23$
  1687. 25$:    movl    d0,a0@+
  1688. 23$:    dbra    d4,25$
  1689. shiftif:movl    a3,d0           | d0 pointe sur resultat
  1690. shiftig:moveml  sp@+,d2-d7/a2-a3
  1691.         unlk    a6
  1692.         rts
  1693.  
  1694. #===================================================================#
  1695. #                                                                   #
  1696. #                       Shift reel = reel                           #
  1697. #                                                                   #
  1698. #       entree : a7@(4) pointe sur r2 de type R                     #
  1699. #                a7@(8) contient k = nombre de shifts               #
  1700. #       sortie : d0 pointe sur r1 de type R                         #
  1701. #                avec r1 = 2^k * r2 zone creee)                     #
  1702. #                                                                   #
  1703. #===================================================================#
  1704.  
  1705. _shiftr:link    a6,#0
  1706.         moveml  d2/a2-a3,sp@-
  1707.         movl    a6@(8),a2       | a2 pointe sur r2
  1708.         movl    a6@(12),d2      | d2.l contient k
  1709.         bne     1$
  1710.                                 | ici k = 0
  1711.         movw    a2@(2),d0
  1712.         bsr     getr
  1713.         movl    a0,a3
  1714.         subqw   #2,d0
  1715.         addql   #4,a0
  1716.         addql   #4,a2
  1717. 4$:     movl    a2@+,a0@+
  1718.         dbra    d0,4$           | boucle de recopie de r2 dans r1
  1719.         bra     shiftrf
  1720.                                 | ici k <> 0
  1721. 1$:     movl    a2@(4),d1
  1722.         andl    #0xffffff,d1
  1723.         addl    d2,d1           | d1.l contient fexp2 + k
  1724.         bvc     sh
  1725.                                 | ici debordement
  1726. shier:  movl    #shier2,sp@-
  1727.         jsr     _err
  1728.                                 | ici k + fexp2 <= 2^31 -1
  1729. sh:     cmpl    #0x1000000,d1
  1730.         bcc     shier           | si k + fexp2 >= 2^24
  1731.         tstl    d1
  1732.         bmi     shier           | si k + fexp2 < 0
  1733.         movw    a2@(2),d0
  1734.         bsr     getr            | allocation memoire pour resultat
  1735.         movl    a0,a3
  1736.         movl    d1,a0@(4)       | mise exposant
  1737.         movb    a2@(4),a0@(4)   | mise signe
  1738.         addql   #8,a0
  1739.         addql   #8,a2
  1740.         subqw   #3,d0
  1741. 5$:     movl    a2@+,a0@+
  1742.         dbra    d0,5$
  1743. shiftrf:movl    a3,d0           | d0 pointe sur resultat
  1744.         moveml  sp@+,d2/a2-a3
  1745.         unlk    a6
  1746.         rts
  1747.  
  1748.  
  1749.  
  1750.  
  1751.  
  1752. #*******************************************************************#
  1753. #*******************************************************************#
  1754. #**                                                               **#
  1755. #**                     PROGRAMMES DE PARTIE ENTIERE              **#
  1756. #**                                                               **#
  1757. #*******************************************************************#
  1758. #*******************************************************************#
  1759.  
  1760.  
  1761.  
  1762.  
  1763.  
  1764. #===================================================================#
  1765. #                                                                   #
  1766. #               Fausse partie entiere (trunc)                       #
  1767. #                                                                   #
  1768. #       entree : a7@(4) pointe sur n1 de type I ou de type R        #
  1769. #       sortie : d0 pointe sur i1 de type I (zone creee)            #
  1770. #       calcul : si r1 >= 0 , i1 est la partie entiere              #
  1771. #                si r1 < 0 , i1 = - Ent (-r1)                       #
  1772. #       remarque : type S interdit                                  #
  1773. #                                                                   #
  1774. #===================================================================#
  1775.  
  1776. _mptrunc:link   a6,#0
  1777.         moveml  d2-d6/a2-a4,sp@-
  1778.         movl    a6@(8),a1       | a1 pointe sur n1
  1779.         cmpb    #1,a1@
  1780.         bne     5$
  1781.                                 | ici n1 est de type I
  1782.         movw    a1@(6),d0
  1783.         bsr     geti
  1784.         movl    a0,a4
  1785.         subqw   #2,d0
  1786.         addql   #4,a0
  1787.         addql   #4,a1
  1788. 7$:     movl    a1@+,a0@+
  1789.         dbra    d0,7$
  1790.         bra     truncf
  1791.                                 | ici n1 est de type R
  1792. 5$:     movl    a1@(4),d3       | d3.l contient second long mot code r1
  1793.         movl    d3,d0
  1794.         andl    #0xffffff,d0    | d0.l contient fexp1
  1795.         subl    #0x800000,d0    | d0.l contient exp1
  1796.         bpl     1$
  1797.                                 | ici exp1 < 0 (trunc r1 = 0)
  1798.     movl    _gzero,d0
  1799.         bra     truncg
  1800.                                 | ici exp1 >= 0
  1801. 1$:     movl    d0,d2           | d2.l  contient exp1
  1802.         lsrl    #5,d0           | d0.l contient exp1 div 32 = q
  1803.         addql   #3,d0           | d0.l  contient le(i1)
  1804.         cmpl    #0x7fff,d0
  1805.         bls     2$
  1806.                                 | ici le(i1)> 2^15 : erreur
  1807.         movl    #truer1,sp@-
  1808.         jsr     _err
  1809.                                 | ici le(i1)<=2^15
  1810. 2$:     bsr     geti            | allocation q+3 longs mots pour i1
  1811.         movl    a0,a4
  1812.         movw    d0,a0@(6)       | mise longueur effective de i1
  1813.         movb    a1@(4),a0@(4)   | mise signe de i1
  1814.         movl    a0,a3           | sauvegarde adresse i1
  1815.         addql   #8,a0
  1816.         addql   #8,a1           | a0,a1 pointent sur mantisses i1,r1
  1817.         movw    a1@(-6),d1      | d1.w contient l(r1)
  1818.         subw    d0,d1           | d1.w contient l(r1)-le(i1)
  1819.         bpl     3$
  1820.                                 | ici l(r1)<le(i1) : erreur
  1821.         movl    #truer2,sp@-
  1822.         jsr     _err
  1823.                                 | ici l(r1)>=le(i1)
  1824. 3$:     subqw   #3,d0           | d0.w contient l(i1)-1 (compteur)
  1825.         addqb   #1,d2           | d2.b contient exp1+1 (derniers bits)
  1826.         andb    #31,d2          | d2.b contient exp1+1 mod 32
  1827.         bne     4$
  1828.                                 | ici pas de shift a faire
  1829. 8$:     movl    a1@+,a0@+
  1830.         dbra    d0,8$           | recopie des mantisses
  1831.         bra     truncf
  1832.                                 | ici d2.b shifts a faire
  1833. 4$:     moveq   #1,d6
  1834.         lsll    d2,d6
  1835.         subql   #1,d6           | masque de shift
  1836.         moveq   #0,d5
  1837. 6$:     movl    a1@+,d3         | boucle de shift
  1838.         roll    d2,d3
  1839.         movl    d3,d4
  1840.         andl    d6,d4
  1841.         subl    d4,d3
  1842.         addl    d5,d4
  1843.         movl    d4,a0@+
  1844.         movl    d3,d5
  1845.         dbra    d0,6$
  1846. truncf: movl    a4,d0           | d0 pointe sur resultat
  1847. truncg: moveml  sp@+,d2-d6/a2-a4
  1848.         unlk    a6
  1849.         rts
  1850.  
  1851. #===================================================================#
  1852. #                                                                   #
  1853. #               Fausse partie entiere (par valeur)                  #
  1854. #                                                                   #
  1855. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1856. #                a7@(8) pointe sur n1 de type I ou R                #
  1857. #       sortie : la zone pointee par a7@(8) contient trunc(n2)      #
  1858. #       interdit : type S                                           #
  1859. #                                                                   #
  1860. #===================================================================#
  1861.  
  1862. _mptruncz:movl  sp@(4),sp@-
  1863.         bsr     _mptrunc
  1864.         movl    sp@(12),sp@
  1865.         movl    d0,sp@-
  1866.         bsr     _mpaff
  1867.         movl    d0,a0
  1868.         addql   #8,sp
  1869.         bra     giv
  1870.  
  1871. #===================================================================#
  1872. #                                                                   #
  1873. #               Partie entiere ( max { n <= x} )                    #
  1874. #                                                                   #
  1875. #       entree : a7@(4) pointe sur n1 de type I ou R                #
  1876. #       sortie : d0 pointe sur i1 de type I (zone creee)            #
  1877. #       remarque : type S interdit                                  #
  1878. #                                                                   #
  1879. #===================================================================#
  1880.  
  1881. _mpent: link    a6,#0
  1882.         moveml  d2-d6/a2-a4,sp@-
  1883.         movl    a6@(8),a1       | a1 pointe sur n1
  1884.         cmpb    #1,a1@
  1885.         bne     1$
  1886.                                 | ici n1 est de type I
  1887.         movw    a1@(6),d0       | d0.w recoit le1
  1888.         bsr     geti
  1889.         movl    a0,a4           | sauvegarde adresse resultat
  1890.         subqw   #2,d0
  1891.         addql   #4,a0
  1892.         addql   #4,a1
  1893. 6$:     movl    a1@+,a0@+
  1894.         dbra    d0,6$
  1895.         bra     entf
  1896.                                 | ici n1 est de type R
  1897. 1$:     tstb    a1@(4)
  1898.         blt     2$
  1899.                                 | ici n1 >= 0 (ent(n1)=trunc(n1))
  1900.         movl    a6@(8),sp@-     | empilage adresse n1
  1901.         bsr     _mptrunc
  1902.         movl    d0,a4           | sauvegarde adresse resultat
  1903.         addql   #4,sp
  1904.         bra     entf
  1905.                                 | ici n1 < 0
  1906. 2$:     movl    a1@(4),d3
  1907.         andl    #0xffffff,d3
  1908.         subl    #0x800000,d3    | d3.l contient exp1
  1909.         bpl     3$
  1910.                                 | ici exp1 < 0 (ent(n1)=-1)
  1911.         moveq   #3,d0
  1912.         bsr     geti
  1913.         movl    a0,a4           | sauvegarde adresse resultat
  1914.         movl    #0xff000003,a0@(4)
  1915.         movl    #1,a0@(8)
  1916.         bra     entf
  1917.                                 | ici exp1 >= 0
  1918. 3$:     movl    _avma,a3        | ancien _avma dans var. locale
  1919.         movl    a6@(8),sp@-     | empilage adresse n1
  1920.         bsr     _mptrunc
  1921.         movl    d0,a4           | sauvegarde adresse res. provisoire
  1922.         addql   #4,sp           | depilage des parametres
  1923.         movl    d3,d1           | d1.l contient exp1
  1924.         lsrl    #5,d3           | d3.l contient exp1 div 32 = q
  1925.         andl    #31,d1          | d1.l contient exp1 mod 32 = r
  1926.         movl    a6@(8),a1
  1927.         lea     a1@(8,d3:l:4),a2| a2 pointe q+1eme lgmot mantisse
  1928.         movl    #0x80000000,d6  | d6.l contient 2^31
  1929.         lsrl    d1,d6           | d6.l  contient 2^(31-r)
  1930.         subql   #1,d6           | masque:0...01...1 avec r+1 zeros
  1931.         moveq   #0,d2
  1932.         movw    a1@(2),d2
  1933.         subql   #3,d2           | d2.l contient L1-1
  1934.         subl    d3,d2           | d2.l contient L1-1-q
  1935.         movl    a2@+,d5         | d5.l contient le q+1 eme lgmot
  1936.         andl    d6,d5
  1937.         beq     4$
  1938.         bra     5$
  1939. 7$:     tstl    a2@+
  1940. 4$:     dbne    d2,7$
  1941.         bne     5$
  1942.                                 | ici tous les lgmots sont nuls
  1943.         bra     entf
  1944.                                 | ici un au moins non nul
  1945. 5$:     movl    a4,sp@-         | empilage trunc(n1)
  1946.         movl    #0xffffffff,sp@-| empilage -1
  1947.         bsr     _addsi          | calcul de trunc(n1)-1
  1948.         addql   #8,sp           | depilage
  1949.         movl    a4,a1           | a1 pointe sur trunc(n1)
  1950.         movl    a3,a4           | a4 contient _avma ancien
  1951.         movl    d0,a0           | a0 pointe sur resultat (res)
  1952.         movw    a0@(2),d0       | d0.w contient l(res)
  1953.         subqw   #1,d0           | d0.w contient l-1
  1954. 8$:     movl    a1@-,a4@-
  1955.         dbra    d0,8$           | transfert du resultat ds pile PARI
  1956.         movl    a4,_avma        | mise a jour pile PARI
  1957. entf:   movl    a4,d0           | d0 pointe sur resultat
  1958.         moveml  sp@+,d2-d6/a2-a4
  1959.         unlk    a6
  1960.         rts
  1961.  
  1962. #===================================================================#
  1963. #                                                                   #
  1964. #                       Partie entiere (par valeur)                 #
  1965. #                                                                   #
  1966. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  1967. #                a7@(8) pointe sur n1 de type I ou R                #
  1968. #       sortie : la zone pointee par a7@(8) contient ent(n2)        #
  1969. #       interdit : type S                                           #
  1970. #                                                                   #
  1971. #===================================================================#
  1972.  
  1973. _mpentz:movl    sp@(4),sp@-
  1974.         bsr     _mpent
  1975.         movl    sp@(12),sp@
  1976.         movl    d0,sp@-
  1977.         bsr     _mpaff
  1978.         movl    d0,a0
  1979.         addql   #8,sp
  1980.         bra     giv
  1981.  
  1982.  
  1983.  
  1984.  
  1985.  
  1986. #*******************************************************************#
  1987. #*******************************************************************#
  1988. #**                                                               **#
  1989. #**             PROGRAMMES DE COMPARAISON                         **#
  1990. #**                                                               **#
  1991. #*******************************************************************#
  1992. #*******************************************************************#
  1993.  
  1994.  
  1995.  
  1996.  
  1997.  
  1998. #===================================================================#
  1999. #                                                                   #
  2000. #                       Comparaison generale                        #
  2001. #                                                                   #
  2002. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  2003. #                a7@(8) pointe sur n1 de type I ou R                #
  2004. #       sortie : d0.l contient -1 si n2<n1,0 si n2=n1,1 sinon.      #
  2005. #                d1,a0,a1 sont sauvegardes                          #
  2006. #       interdit : type S                                           #
  2007. #                                                                   #
  2008. #===================================================================#
  2009.  
  2010. _mpcmp: link    a6,#0
  2011.         moveml  d1-d2/a1-a2,sp@-
  2012.         movl    a6@(8),a2
  2013.         movl    a6@(12),a1      | a1 et a2 pointent sur n1 et n2
  2014.         moveq   #0,d1
  2015.         movb    a2@,d2          | d2.b contient T2
  2016.         cmpb    a1@,d2
  2017.         ble     1$
  2018.                                 | ici T2 > T1
  2019.         exg     a1,a2
  2020.         moveq   #1,d1
  2021.                                 | ici T2 <= T1
  2022. 1$:     movl    a1,sp@-
  2023.         movl    a2,sp@-
  2024.         cmpb    #1,a1@
  2025.         bne     2$
  2026.                                 | ici T1 = T2 = I
  2027.         bsr     _cmpii
  2028.         bra     cmpf
  2029.                                 | ici T1 = R
  2030. 2$:     cmpb    #1,a2@
  2031.         bne     3$
  2032.                                 | ici T1 = R et T2 = I
  2033.         bsr     _cmpir
  2034.         bra     cmpf
  2035.                                 | ici T1 = T2 = R
  2036. 3$:     bsr     _cmprr
  2037. cmpf:   addql   #8,sp
  2038.         tstb    d1
  2039.         beq     1$
  2040.         negl    d0
  2041. 1$:     moveml  sp@+,d1-d2/a1-a2
  2042.         unlk    a6
  2043.         rts
  2044.  
  2045. #===================================================================#
  2046. #                                                                   #
  2047. #       Comparaison : entier court et entier court                  #
  2048. #                                                                   #
  2049. #       entree : a7@(4) contient s2 de type S                       #
  2050. #                a7@(8) contient s1 de type S                       #
  2051. #       sortie : d0.l contient  -1 si s2<s1,0 si s2=s1,1 sinon      #
  2052. #                d1,a0,a1 sont sauvegardes                          #
  2053. #                                                                   #
  2054. #===================================================================#
  2055.  
  2056. _cmpss: link    a6,#0
  2057.         moveml  d1-d2,sp@-
  2058.         movl    a6@(8),d2       | d2.l contient s2
  2059.         movl    a6@(12),d1      | d1.l contient s1
  2060.         cmpl    d1,d2
  2061.         beq     1$
  2062.         bpl     2$
  2063.                                 | ici s2 < s1
  2064.         moveq   #-1,d0
  2065.         bra     cmpssf
  2066.                                 | ici s2 > s1
  2067. 2$:     moveq   #1,d0
  2068.         bra     cmpssf
  2069.                                 | ici s2 = s1
  2070. 1$:     moveq   #0,d0
  2071. cmpssf: moveml  sp@+,d1-d2
  2072.         unlk    a6
  2073.         rts
  2074.  
  2075. #===================================================================#
  2076. #                                                                   #
  2077. #               Comparaison : entier court et entier                #
  2078. #                                                                   #
  2079. #       entree : a7@(4) contient s2 de type S                       #
  2080. #                a7@(8) pointe sur i1 de type I                     #
  2081. #       sortie : d0.l contient 1 si s2>i1,0 si s2=i1,-1 sinon       #
  2082. #                d1,a0,a1 sont sauvegardes                          #
  2083. #                                                                   #
  2084. #===================================================================#
  2085.  
  2086. _cmpsi: link    a6,#0
  2087.         moveml  d1-d4/a1,sp@-
  2088.         movl    a6@(12),a1      | a1 pointe sur i1
  2089.         movb    a1@(4),d1       | d1.b contient signe de i1 (si1)
  2090.         movb    d1,d4           | d4.b contient si1
  2091.         movb    #1,d3
  2092.         movl    a6@(8),d2       | d2.l contient s2
  2093.         bgt     1$              | si s2 > 0
  2094.                                 | ici s2 <= 0
  2095.         bne     2$              | si s2 < 0
  2096.                                 | ici s2 = 0
  2097.         movb    #0,d3
  2098.         bra     1$
  2099.                                 | ici s2 < 0
  2100. 2$:     movb    #-1,d3          | d3.b contient signe de s2 (ss2)
  2101. 1$:     eorb    d3,d4           | d4.b contient :
  2102.                                 | 0 si les deux nuls ou >0 ou <0
  2103.                                 | >0 si un nul l'autre >0
  2104.                                 | <0 si un nul autre<0,un<0 autre>0     
  2105.         bpl     3$
  2106.                                 | ici d4.b < 0
  2107.         moveq   #1,d0
  2108.         tstb    d3
  2109.         bpl     4$
  2110.                                 | ici s2<0 et i1>0
  2111.         moveq   #-1,d0
  2112. 4$:     bra     cmpsif
  2113.                                 | ici d4.b >=0
  2114. 3$:     cmpw    #3,a1@(6)
  2115.         ble     5$
  2116.                                 | ici L1 >= 2
  2117. 8$:     moveq   #-1,d0
  2118.         tstb    d1
  2119.         bpl     6$
  2120.         negl    d0
  2121. 6$:     bra     cmpsif
  2122.                                 | ici L1 <= 1
  2123. 5$:     cmpw    #2,a1@(6)
  2124.         beq     7$
  2125.                                 | ici L1 = 1
  2126.         tstl    d2
  2127.         bpl     9$
  2128.         negl    d2
  2129. 9$:     moveq   #1,d0
  2130.         cmpl    a1@(8),d2
  2131.         bhi     10$
  2132.         bne     11$
  2133.         moveq   #0,d0
  2134.         bra     cmpsif
  2135. 11$:    moveq   #-1,d0
  2136. 10$:    tstb    d1
  2137.         bpl     cmpsif
  2138.         negl    d0
  2139.         bra     cmpsif
  2140. 7$:     moveq   #1,d0
  2141.         tstb    d3
  2142.         bne     cmpsif
  2143.         moveq   #0,d0
  2144. cmpsif: moveml  sp@+,d1-d4/a1
  2145.         unlk    a6
  2146.         rts
  2147.  
  2148. #===================================================================#
  2149. #                                                                   #
  2150. #               Comparaison : entier court et reel                  #
  2151. #                                                                   #
  2152. #       entree : a7@(4) contient s2 de type S                       #
  2153. #                a7@(8) pointe sur r1 de type R                     #
  2154. #       sortie : d0.l contient 1 si s2>r1, 0 si s2=r1, -1 sinon     #
  2155. #                d1,a0,a1 sont sauvegardes                          #
  2156. #                                                                   #
  2157. #===================================================================#
  2158.  
  2159. _cmpsr: link    a6,#0
  2160.         moveml  d1-d4/a0-a2,sp@-
  2161.         movl    a6@(12),a1      | a1 pointe sur r1
  2162.         movb    a1@(4),d1       | d1.b contient sr1 (signe de r1)
  2163.         movb    d1,d4           | d4.b aussi
  2164.         movb    #1,d3
  2165.         movl    a6@(8),d2       | d2.l contient s2
  2166.         bgt     1$
  2167.         bne     2$
  2168.         movb    #0,d3
  2169.         bra     1$
  2170. 2$:     movb    #-1,d3          | d3.b contient ss2 (signe de s2)
  2171. 1$:     eorb    d3,d4           | d4.b contient 'signe'
  2172.         bpl     3$
  2173.                                 | ici d4.b < 0
  2174.         moveq   #1,d0
  2175.         tstb    d3
  2176.         bpl     4$
  2177.         moveq   #-1,d0
  2178. 4$:     bra     cmpsrf
  2179.                                 | ici d4.b >= 0
  2180. 3$:     tstb    d1
  2181.         bne     5$
  2182.                                 | ici r1 = 0
  2183.         moveq   #1,d0
  2184.         tstb    d3
  2185.         bne     6$
  2186.                                 | ici s2 = r1 = 0
  2187.         moveq   #0,d0
  2188. 6$:     bra     cmpsrf
  2189.                                 | ici r1 <> 0
  2190. 5$:     movw    a1@(2),d0
  2191.         bsr     getr            | pour copie reelle de s2
  2192.         movl    a0,a2   | sauvegarde adresse copie
  2193.         movl    a0,sp@-         | empilage adresse copie
  2194.         movl    d2,sp@-         | empilage s2
  2195.         bsr     _affsr
  2196.         addql   #8,sp           | depilage
  2197.         movl    a1,sp@-         | empilage adresse r1
  2198.         movl    a0,sp@-         | empilage adresse copie
  2199.         bsr     _cmprr
  2200.         addql   #8,sp
  2201.         movl    a2,a0
  2202.         bsr     giv
  2203. cmpsrf: moveml  sp@+,d1-d4/a0-a2
  2204.         unlk    a6
  2205.         rts
  2206.  
  2207. #===================================================================#
  2208. #                                                                   #
  2209. #               Comparaison : entier et entier court                #
  2210. #                                                                   #
  2211. #       entree : a7@(4) pointe sur i2 de type I                     #
  2212. #                a7@(8) contient s1                                 #
  2213. #       sortie : d0.l contient le signe de i2 - s1                  #
  2214. #                aucun autre registre n'est affecte                 #
  2215. #                                                                   #
  2216. #===================================================================#
  2217.  
  2218. _cmpis: movl    sp@(4),sp@-
  2219.         movl    sp@(12),sp@-
  2220.         bsr     _cmpsi
  2221.         addql   #8,sp
  2222.         negl    d0
  2223.         rts
  2224.  
  2225. #===================================================================#
  2226. #                                                                   #
  2227. #               Comparaison : entier et entier                      #
  2228. #                                                                   #
  2229. #       entree : a7@(4) pointe sur i2 de type I                     #
  2230. #                a7@(8) pointe sur i1 de type I                     #
  2231. #       sortie : d0.l contient :1 si i2>i1,0 si i2=i1,-1 sinon      #
  2232. #                d1,a0,a1 sont sauvegardes                          #
  2233. #                                                                   #
  2234. #===================================================================#
  2235.  
  2236. _cmpii: link    a6,#0
  2237.         moveml  d1-d4/a1-a2,sp@-
  2238.         movl    a6@(8),a2
  2239.         movl    a6@(12),a1      | a1, a2 pointent sur i1, i2
  2240.         movb    a1@(4),d1       | d1.b contient si1
  2241.         movb    d1,d4
  2242.         movb    a2@(4),d2       | d2.b contient si2
  2243.         eorb    d2,d4
  2244.         bpl     1$
  2245.                                 | ici d4.b < 0
  2246.         moveq   #1,d0
  2247.         tstb    d2
  2248.         bpl     cmpiif
  2249.         moveq   #-1,d0
  2250.         bra     cmpiif
  2251.                                 | ici d4.b >= 0
  2252. 1$:     movw    a1@(6),d1
  2253.         movw    a2@(6),d2       | d1.w et d2.w contiennent le1 et le2
  2254.         cmpw    d1,d2
  2255.         blt     3$
  2256.         beq     4$
  2257.                                 | ici le2 > le1
  2258. 6$:     moveq   #1,d0
  2259.         tstb    a1@(4)
  2260.         bpl     cmpiif
  2261.         moveq   #-1,d0
  2262.         bra     cmpiif
  2263.                                 | ici le2 < le1
  2264. 3$:     moveq   #-1,d0
  2265.         tstb    a2@(4)
  2266.         bpl     cmpiif
  2267.         moveq   #1,d0
  2268.         bra     cmpiif
  2269.                                 | ici le2 = le1
  2270. 4$:     cmpw    #2,d1
  2271.         bne     7$
  2272.         moveq   #0,d0
  2273.         bra     cmpiif
  2274.                                 | ici i1 et i2 <> 0
  2275. 7$:     movb    a1@(4),d3
  2276.         addql   #8,a1
  2277.         addql   #8,a2
  2278.         subqw   #3,d1
  2279. 11$:    cmpml   a1@+,a2@+
  2280.         dbne    d1,11$
  2281.         bhi     8$
  2282.         beq     9$
  2283.         moveq   #-1,d0
  2284.         bra     10$
  2285. 9$:     moveq   #0,d0
  2286.         bra     cmpiif
  2287. 8$:     moveq   #1,d0
  2288. 10$:    tstb    d3
  2289.         bpl     cmpiif
  2290.         negl    d0
  2291. cmpiif: moveml  sp@+,d1-d4/a1-a2
  2292.         unlk    a6
  2293.         rts
  2294.  
  2295. #===================================================================#
  2296. #                                                                   #
  2297. #               Comparaison : entier et reel                        #
  2298. #                                                                   #
  2299. #       entree : a7@(4) pointe sur i2 de type R                     #
  2300. #                a7@(8) pointe sur r1 de type R                     #
  2301. #       sortie : d0.l contient :1 si i2>r1,0 si i2=r1,-1 sinon      #
  2302. #                d1,a0,a1 sont sauvegardes                          #
  2303. #                                                                   #
  2304. #===================================================================#
  2305.  
  2306. _cmpir: link    a6,#0
  2307.         moveml  d1-d4/a0-a3,sp@-
  2308.         movl    a6@(8),a2
  2309.         movl    a6@(12),a1      | a1 et a2 pointent sur r1 et i2
  2310.         movb    a1@(4),d1
  2311.         movb    d1,d4
  2312.         movb    a2@(4),d2
  2313.         eorb    d2,d4
  2314.         bpl     1$
  2315.         moveq   #1,d0
  2316.         tstb    d2
  2317.         bpl     2$
  2318.         moveq   #-1,d0
  2319. 2$:     bra     cmpirf
  2320.                                 | ici d4.b >= 0
  2321. 1$:     tstb    d1
  2322.         bne     3$
  2323.         moveq   #1,d0
  2324.         tstb    d2
  2325.         bne     4$
  2326.         moveq   #0,d0
  2327. 4$:     bra     cmpirf
  2328.                                 | ici faire copie de i2 en type R
  2329. 3$:     movw    a1@(2),d0       | allouer memoire pour copie de i2
  2330.         bsr     getr
  2331.         movl    a0,a3
  2332.         movl    a0,sp@-         | empiler adresse copie
  2333.         movl    a2,sp@-         | empiler adresse i2
  2334.         bsr     _affir
  2335.         addql   #8,sp           | depiler
  2336.         movl    a1,sp@-         | empiler adresse r1
  2337.         movl    a0,sp@-         | empiler adresse copie
  2338.         bsr     _cmprr
  2339.         addql   #8,sp           | depiler
  2340.         movl    a3,a0
  2341.         bsr     giv             | rendre copie
  2342. cmpirf: moveml  sp@+,d1-d4/a0-a3
  2343.         unlk    a6
  2344.         rts
  2345.  
  2346. #===================================================================#
  2347. #                                                                   #
  2348. #               Comparaison : reel et entier court                  #
  2349. #                                                                   #
  2350. #       entree : a7@(4) pointe sur r2 de type R                     #
  2351. #                a7@(8) contient s1                                 #
  2352. #       sortie : d0.l contient le signe de r2 - s1                  #
  2353. #                aucun autre registre n'est affecte                 #
  2354. #                                                                   #
  2355. #===================================================================#
  2356.  
  2357. _cmprs: movl    sp@(4),sp@-
  2358.         movl    sp@(12),sp@-
  2359.         bsr     _cmpsr
  2360.         addql   #8,sp
  2361.         negl    d0
  2362.         rts
  2363.  
  2364. #===================================================================#
  2365. #                                                                   #
  2366. #               Comparaison : reel et entier                        #
  2367. #                                                                   #
  2368. #       entree : a7@(4) pointe sur r2 de type R                     #
  2369. #                a7@(8) contient i1                                 #
  2370. #       sortie : d0.l contient le signe de r2 - i1                  #
  2371. #                aucun autre registre n'est affecte                 #
  2372. #                                                                   #
  2373. #===================================================================#
  2374.  
  2375. _cmpri: movl    sp@(4),sp@-
  2376.         movl    sp@(12),sp@-
  2377.         bsr     _cmpir
  2378.         addql   #8,sp
  2379.         negl    d0
  2380.         rts
  2381.  
  2382. #===================================================================#
  2383. #                                                                   #
  2384. #               Comparaison : reel et reel                          #
  2385. #                                                                   #
  2386. #       entree : a7@(4) pointe sur r2 de type R                     #
  2387. #                a7@(8) pointe sur r1 de type R                     #
  2388. #       sortie : d0.l contient :1 si r2>r1,0 si r2=r1,-1 sinon      #
  2389. #                d1,a0,a1 sont sauvegardes                          #
  2390. #                                                                   #
  2391. #===================================================================#
  2392.  
  2393. _cmprr: link    a6,#0
  2394.         moveml  d1-d5/a1-a2,sp@-
  2395.         movl    a6@(8),a2
  2396.         movl    a6@(12),a1      | a1 et a2 pointent sur r1 et r2
  2397.         movb    a1@(4),d1
  2398.         movb    d1,d4
  2399.         movb    a2@(4),d2
  2400.         eorb    d2,d4
  2401.         bpl     1$
  2402.                                 | ici d4.b < 0
  2403.         moveq   #1,d0
  2404.         tstb    d2
  2405.         bpl     2$
  2406.         moveq   #-1,d0
  2407. 2$:     bra     cmprrf
  2408.                                 | ici d4.b >= 0
  2409. 1$:     tstb    d1
  2410.         bne     3$
  2411.         moveq   #1,d0
  2412.         tstb    d2
  2413.         bne     4$
  2414.         moveq   #0,d0
  2415. 4$:     bra     cmprrf
  2416. 3$:     tstb    a2@(4)
  2417.         bne     5$
  2418.         moveq   #-1,d0
  2419.         bra     cmprrf
  2420.                                 | ici r2 <> 0
  2421. 5$:     moveq   #1,d0
  2422.         movw    a1@(2),d1
  2423.         movw    a2@(2),d2
  2424.         cmpw    d1,d2
  2425.         bpl     6$
  2426.         exg     d1,d2
  2427.         exg     a1,a2
  2428.         moveq   #-1,d0
  2429. 6$:     tstb    a2@(4)
  2430.         bpl     7$
  2431.         negl    d0
  2432. 7$:     movl    a1@(4),d5
  2433.         andl    #0xffffff,d5
  2434.         movl    a2@(4),d3
  2435.         andl    #0xffffff,d3
  2436.         cmpl    d5,d3
  2437.         bpl     8$
  2438. 10$:    negl    d0
  2439.         bra     cmprrf
  2440. 8$:     bne     cmprrf
  2441.         subw    d1,d2
  2442.         subqw   #3,d1
  2443.         addql   #8,a1
  2444.         addql   #8,a2
  2445. 9$:     cmpml   a1@+,a2@+
  2446.         dbne    d1,9$
  2447.         bcs     10$
  2448.         beq     11$
  2449.         bra     cmprrf
  2450. 12$:    tstl    a2@+
  2451. 11$:    dbne    d2,12$
  2452.         bne     cmprrf
  2453.         moveq   #0,d0
  2454. cmprrf: moveml  sp@+,d1-d5/a1-a2
  2455.         unlk    a6
  2456.         rts
  2457.  
  2458.  
  2459.  
  2460.  
  2461.  
  2462. #*******************************************************************#
  2463. #*******************************************************************#
  2464. #**                                                               **#
  2465. #**                     PROGRAMMES D'ADDITION                     **#
  2466. #**                                                               **#
  2467. #*******************************************************************#
  2468. #*******************************************************************#
  2469.  
  2470.  
  2471.  
  2472.  
  2473.  
  2474. #===================================================================#
  2475. #                                                                   #
  2476. #                       Addition generale                           #
  2477. #                                                                   #
  2478. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  2479. #                a7@(8) pointe sur n1 de type I ou R                #
  2480. #       sortie : d0 pointe sur n2 + n1 de type I ou R (zone creee)  #
  2481. #       interdit : type S                                           #
  2482. #       precision : voir les formules des routines specalisees      #
  2483. #                                                                   #
  2484. #===================================================================#
  2485.  
  2486. _mpadd: movl    sp@(4),a0
  2487.         movl    sp@(8),a1       | a1 et a0 pointent sur n1 et n2
  2488.         movb    a0@,d0
  2489.         movb    a1@,d1          | d1.b et d0.b contiennent T1 et T2
  2490.         cmpb    d1,d0
  2491.         ble     1$
  2492.                                 | ici T2 > T1
  2493.         exg     a1,a0
  2494.         exg     d1,d0
  2495.         movl    a0,sp@(4)
  2496.         movl    a1,sp@(8)
  2497.                                 | ici T2 <= T1
  2498. 1$:     cmpb    #1,d1
  2499.         beq     _addii          | ici T1 = T2 = I
  2500. 2$:     cmpb    #2,d0
  2501.         beq     _addrr          | ici T1 = T2 = R
  2502.         bra     _addir
  2503.  
  2504. #===================================================================#
  2505. #                                                                   #
  2506. #                       Addition (par valeur)                       #
  2507. #                                                                   #
  2508. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  2509. #                a7@(8) pointe sur n1 de type I ou R                #
  2510. #                a7@(12) pointe sur n3 de type I ou R               #
  2511. #       sortie : la zone pointee par a7@(12) contient n2+n1         #
  2512. #       interdit : type S                                           #
  2513. #                                                                   #
  2514. #===================================================================#
  2515.  
  2516. _mpaddz:lea     _mpadd,a0
  2517.         bra     mpopz
  2518.  
  2519.                                 | addition S+S=I ou R
  2520.  
  2521. _addssz:lea     _addss,a0
  2522.         bra     mpopz
  2523.  
  2524.                                 | addition S+I=I ou R
  2525.  
  2526. _addsiz:lea     _addsi,a0
  2527.         bra     mpopz
  2528.  
  2529.                                 | addition S+R=R sinon erreur
  2530.  
  2531. _addsrz:lea     _addsr,a0
  2532.         bra     mpopz
  2533.  
  2534.                                 | addition I+I=I ou R
  2535.  
  2536. _addiiz:lea     _addii,a0
  2537.         bra     mpopz
  2538.  
  2539.                                 | addition I+R=R sinon erreur
  2540.  
  2541. _addirz:lea     _addir,a0
  2542.         bra     mpopz
  2543.  
  2544.                                 | addition R+R=R sinon erreur
  2545.  
  2546. _addrrz:lea     _addrr,a0
  2547.         bra     mpopz
  2548.  
  2549. #===================================================================#
  2550. #                                                                   #
  2551. #    Addition : entier court + entier court = entier                #
  2552. #                                                                   #
  2553. #       entree : a7@(4) contient s2 de type S                       #
  2554. #                a7@(8) contient s1 de type S                       #
  2555. #       sortie : d0 pointe sur s1+s2 de type I(zone cree)           #
  2556. #       remarque : s1 + s2 = s0 est interdit                        #
  2557. #                                                                   #
  2558. #===================================================================#
  2559.  
  2560. _addss: link    a6,#-2
  2561.         movl    d2,sp@-
  2562.         movl    a6@(8),d1
  2563.         movl    a6@(12),d2
  2564.         addl    d2,d1           | d1.l contient s2 + s1
  2565.         bne     1$
  2566.                                 | ici d1.l=0
  2567.         bvs     2$
  2568.                                 | ici s1+s2=0
  2569.     movl    _gzero,d0
  2570.         bra     addssg
  2571.                                 | ici s1+s2=-2^32 (s1=s2=-2^31)
  2572. 2$:     movw    #4,d0
  2573.         bsr     geti
  2574.         movl    #0xff000004,a0@(4)
  2575.         movl    #1,a0@(8)
  2576.         clrl    a0@(12)
  2577.         bra     addssf
  2578.                                 | ici d1.l<>0
  2579. 1$:     movw    #3,d0
  2580.         bsr     geti
  2581.         movl    #0x1000003,a0@(4)
  2582.         addl    a6@(8),d2       | repositionne les indicateurs
  2583.         bvs     3$
  2584.                                 | ici pas d'overflow
  2585.         bmi     4$              | d1 donne bien le signe du resultat
  2586.         bra     5$
  2587.                                 | ici overflow
  2588. 3$:     bcc     5$              | le carry donne le signe du resultat
  2589. 4$:     negl    d1
  2590.         movb    #0xff,a0@(4)
  2591. 5$:     movl    d1,a0@(8)
  2592. addssf: movl    a0,d0           | d0 pointe sur resultat
  2593. addssg: movl    sp@,d2
  2594.         unlk    a6
  2595.         rts
  2596.  
  2597. #===================================================================#
  2598. #                                                                   #
  2599. #               Addition : entier court + entier = entier           #
  2600. #                                                                   #
  2601. #       entree : a7@(4) contient s2 de type S                       #
  2602. #                a7@(8) pointe sur i1 de type I                     #
  2603. #       sortie : d0 pointe sur s2 + i1 de type I (zone creee)       #
  2604. #                                                                   #
  2605. #===================================================================#
  2606.  
  2607. _addsi: link    a6,#0
  2608.         moveml  d2-d4/a2,sp@-
  2609.         movl    a6@(12),a1      | a1 pointe sur i1
  2610.         movl    a6@(8),d2       | d2.l contient s2
  2611.         bne     1$              | si s2 <> 0
  2612.                                 | ici s2 = 0 (i1 + s2 = i1)
  2613.         movw    a1@(6),d0
  2614.         bsr     geti            | allocation memoire pour resultat
  2615.         movl    a0,d4
  2616.         subqw   #2,d0           | compteur de boucle pour recopie de i1
  2617.         addql   #4,a0
  2618.         addql   #4,a1
  2619. 2$:     movl    a1@+,a0@+       | recopie de i1
  2620.         dbra    d0,2$
  2621.         bra     addsif
  2622.                                 | ici s2 <> 0
  2623. 1$:     tstb    a1@(4)
  2624.         bne     3$              | si i1 <> 0
  2625.                                 | ici i1 = 0 (i1 + s2 = s2)
  2626.         moveq   #3,d0
  2627.         bsr     geti            | allocation memoire pour resultat
  2628.         movl    a0,d4
  2629.         movl    #0x1000003,a0@(4)
  2630.         movl    d2,a0@(8)
  2631.         
  2632.         bpl     addsif
  2633.                                 | ici s2 < 0
  2634.         movb    #0xff,a0@(4)
  2635.         negl    a0@(8)
  2636.         bra     addsif
  2637.                                 | ici s2 et i1 <> 0
  2638. 3$:     movw    a1@(6),d0       | d0.w contient le1
  2639.         bsr     geti
  2640.         movl    a0,d4
  2641.         movw    a1@(4),d1
  2642.         extl    d1              | d1.l contient signe de i1
  2643.         lea     a0@(0,d0:w:4),a0
  2644.         lea     a1@(0,d0:w:4),a2| a0 pointe fin du resultat;a2 fin de i1
  2645.         moveq   #0,d3
  2646.         subqw   #3,d0           | d0.w compteur boucle addition
  2647.         eorl    d2,d1           | comparaison signes i1 et s2
  2648.         bmi     susi            | si i1 * s2 < 0
  2649.                                 | ici i1 * s2 > 0
  2650.         tstl    d2
  2651.         bpl     51$             | valeur absolue de s2
  2652.         negl    d2
  2653. 51$:    addl    a2@-,d2
  2654.         bra     4$              | boucle d'addition
  2655. 5$:     movl    d2,a0@-
  2656.         movl    a2@-,d2
  2657.         addxl   d3,d2
  2658. 4$:     dbra    d0,5$
  2659.         bcc     6$              | ici retenue finale
  2660.         movl    d2,a0@-         | mise a jour dernier long mot
  2661.         moveq   #1,d0
  2662.         bsr     geti            | allocation un long mot supplementaire
  2663.         movl    a0,d4
  2664.         movl    a0@(4),a0@
  2665.         addqw   #1,a0@(2)       | mise a jour premier long mot code
  2666.         cmpw    #0x7fff,a0@(2)
  2667.         bls     7$
  2668.                                 | ici debordement
  2669.         movl    #adder1,sp@-
  2670.         jsr     _err
  2671. 7$:     movw    a0@(2),a0@(6)   | mise longueur effective
  2672.         movl    #1,a0@(8)       | mise a jour retenue finale
  2673.         bra     8$
  2674.                                 | ici pas de retenue finale
  2675. 6$:     movl    d2,a0@-         | mise a jour dernier long mot
  2676.         subqw   #8,a0
  2677.         movw    a0@(2),a0@(6)   | longueur effective
  2678. 8$:     movw    a1@(4),a0@(4)   | signe du resultat
  2679.         movl    a0,d4
  2680. addsif: movl    d4,d0           | d0 pointe sur resultat
  2681.         moveml  sp@+,d2-d4/a2
  2682.         unlk    a6
  2683.         rts
  2684.                                 | ici i1 * s2 < 0 : soustraction
  2685. susi:   movl    d2,d1           | d1.l recoit s2
  2686.         bpl     6$
  2687.         negl    d1              | d1.l recoit |s2|
  2688. 6$:     movl    a2@-,d2
  2689.         subl    d1,d2           | amorcage de la soustraction
  2690.         bra     1$
  2691.                                 | boucle de soustraction
  2692. 2$:     movl    d2,a0@-
  2693.         movl    a2@-,d2
  2694.         subxl   d3,d2
  2695. 1$:     dbra    d0,2$
  2696.         bcc     3$
  2697.                                 | ici retenue finale:longueur resultat=3
  2698.         negl    d2
  2699.         movl    d2,a0@-
  2700.         subql   #8,a0           | a0 pointe sur resultat
  2701.         movw    #3,a0@(6)       | mise a jour longueur effective
  2702.         movb    a1@(4),d2
  2703.         negb    d2
  2704.         movb    d2,a0@(4)       | mise a jour signe (-|i1|)
  2705.         bra     addsif
  2706.                                 | ici pas de retenue finale
  2707. 3$:     tstl    d2
  2708.         beq     4$
  2709.                                 | ici d2 <> 0
  2710.         movl    d2,a0@-
  2711.         movl    a1@(4),a0@-     | mise a jour second long mot code
  2712.         bra     addsif
  2713.                                 | ici d2 = 0
  2714. 4$:     movl    a1@(4),a0@-
  2715.         subqw   #1,a0@(2)
  2716.         cmpw    #2,a0@(2)
  2717.         bne     5$
  2718.                                 | ici L1 = 1 ; le resultat est 0
  2719.         clrb    a0@
  2720. 5$:     movl    a0@(-8),a0@-
  2721.         subqw   #1,a0@(2)
  2722.         movl    a0,d4
  2723.         addql   #4,_avma                | mise a jour pile PARI
  2724.         bra     addsif
  2725.  
  2726. #===================================================================#
  2727. #                                                                   #
  2728. #               Addition : entier + entier = entier                 #
  2729. #                                                                   #
  2730. #       entree : a7@(4) pointe sur i2 de type I                     #
  2731. #                a7@(8) pointe sur i1 de type I                     #
  2732. #       sortie : d0 pointe sur i2 + i1 de type I (zone creee)       #
  2733. #                                                                   #
  2734. #===================================================================#
  2735.  
  2736. _addii: link    a6,#0
  2737.         moveml  d2-d7/a2-a4,sp@-
  2738.         movl    a6@(8),a2       | a2 pointe sur i2
  2739.         movl    a6@(12),a1      | a1 pointe sur i1
  2740.         moveq   #0,d2
  2741.         moveq   #0,d1
  2742.         movw    a2@(6),d2
  2743.         movw    a1@(6),d1       | d1.w recoit le1 et d2.w recoit le2
  2744.         cmpw    d1,d2
  2745.         bcc     1$
  2746.         exg     a1,a2
  2747.         exg     d1,d2           | si L2 < L1 ,echanger a1,a2 et d1,d2
  2748.                                 | ici L2 >= L1
  2749. 1$:     tstb    a1@(4)
  2750.         bne     2$              | ici i1 = 0 : i1 + i2 = i2
  2751.         movw    a2@(6),d0
  2752.         bsr     geti            | allocation memoire pour recopie de i2
  2753.         subqw   #2,d0           | compteur de recopie
  2754.         movl    a0,a1
  2755.         addql   #4,a1
  2756.         addql   #4,a2
  2757.                                 | boucle de recopie
  2758. 3$:     movl    a2@+,a1@+
  2759.         dbra    d0,3$
  2760.         bra     addiif
  2761.                                 | ici i1 <> 0 ( donc i2 <> 0)
  2762. 2$:     movb    a1@(4),d3
  2763.         movb    a2@(4),d4
  2764.         eorb    d4,d3           | d3 contient signe de i2 * i1
  2765.         bmi     suii
  2766.                                 | ici i2 * i1 > 0
  2767.         movw    d2,d0
  2768.         bsr     geti            | allocation memoire le2 longs mots
  2769.         lea     a0@(0,d0:w:4),a0| a0 pointe fin du resultat
  2770.         lea     a2@(0,d0:w:4),a2| a2 pointe fin de i2
  2771.         lea     a1@(0,d1:w:4),a1| a1 pointe fin de i1
  2772.         subw    d1,d2           | d2.w contient L2-L1
  2773.         subqw   #3,d1           | d1.w contient L1-1 (compteur)
  2774.         moveq   #0,d4
  2775.                                 | ici premiere boucle d'addition
  2776. 4$:     movl    a1@-,d0
  2777.         movl    a2@-,d5
  2778.         addxl   d5,d0
  2779.         movl    d0,a0@-
  2780.         dbra    d1,4$
  2781.         roxrw   d4,d0           | mise a jour dernier long mot
  2782.         bra     5$
  2783.                                 | ici deuxieme boucle:propagation carry
  2784. 6$:     movl    a2@-,d0
  2785.         addxl   d4,d0
  2786.         movl    d0,a0@-
  2787.         roxrw   d4,d0
  2788. 5$:     dbcc    d2,6$
  2789.         bcs     7$              | si carry jusqu'a la fin
  2790.                                 | ici pas de carry
  2791.         bra     8$
  2792.                                 | ici troisieme boucle:recopie mantisse
  2793. 9$:     movl    a2@-,a0@-
  2794. 8$:     dbra    d2,9$
  2795.                                 | ici pas de carry finale
  2796.         movl    a2@-,a0@-
  2797.         subql   #4,a0
  2798.         bra     addiif
  2799.                                 | ici carry finale
  2800. 7$:     movw    a2@(-2),d2
  2801.         addqw   #1,d2
  2802.         cmpw    #0x8000,d2
  2803.         bcs     10$
  2804.                                 | ici debordement
  2805.         movl    #adder2,sp@-
  2806.         jsr     _err
  2807.                                 | ici demander 1 long mot en plus
  2808. 10$:    moveq   #1,d0
  2809.         bsr     geti
  2810.         movl    #1,a0@(8)       | mise retenue
  2811.         movl    a0@(4),a0@
  2812.         movw    d2,a0@(2)       | mise a jour premier long mot code
  2813.         movl    a2@-,a0@(4)
  2814.         movw    d2,a0@(6)       | idem deuxieme long mot code
  2815. addiif: movl    a0,d0           | d0 pointe sur resultat
  2816. addiig: moveml  sp@+,d2-d7/a2-a4
  2817.         unlk    a6
  2818.         rts
  2819.                                 | ici i2 * i1 < 0 : soustraction
  2820. suii:   movl    a1,a3
  2821.         movl    a2,a4           | a3,a4 pointent sur i1,i2
  2822.         subw    d1,d2           | d2.w contient L2-L1
  2823.         bne     1$
  2824.                                 | ici L2=L1
  2825.         subqw   #3,d1           | d1.w  contient L1-1
  2826.         addql   #8,a3
  2827.         addql   #8,a4           | a3,a4 pointent debut mantisses i1,i2
  2828. 2$:     cmpml   a3@+,a4@+
  2829.         dbne    d1,2$           | on compare |i1| et |i2|
  2830.         bhi     1$              | si |i2| > |i1|
  2831.                                 | ici |i2| < |i1|
  2832.         bne     3$
  2833.                                 | ici |i2| = |i1| : i2 + i1 = 0
  2834.     movl    _gzero,d0
  2835.         bra     addiig
  2836.                                 | ici |i2| < |i1| : echanger i2 et i1
  2837. 3$:     exg     a1,a2
  2838.                                 | ici |i2| > |i1| (signe i2=signe resultat)
  2839. 1$:     movw    a2@(6),d0
  2840.         bsr     geti            | allocation memoire le2 longs mots
  2841.         movw    a1@(6),d1       | d1.w  contient L1+2
  2842.         movl    a0,sp@-         | empilage adresse resultat
  2843.         movb    a2@(4),d7       | d7.b  contient signe resultat
  2844.         lea     a1@(0,d1:w:4),a1
  2845.         lea     a2@(0,d0:w:4),a2
  2846.         lea     a0@(0,d0:w:4),a0| a0,a1,a2 pointent fin resultat,i1,i2
  2847.         subl    d3,d3           | initialisation bit X
  2848.         subqw   #3,d1           | d1.w contient L1-1 (compteur)
  2849.                                 | premiere boucle de soustraction
  2850. 4$:     movl    a2@-,d0
  2851.         movl    a1@-,d5
  2852.         subxl   d5,d0
  2853.         movl    d0,a0@-
  2854.         dbra    d1,4$
  2855.         roxrw   d3,d0           | restauration du bit C
  2856.         bra     5$
  2857.                                 | deuxieme boucle:propagation carry
  2858. 6$:     movl    a2@-,d5
  2859.         subxl   d3,d5
  2860.         movl    d5,a0@-
  2861.         roxrw   d3,d0
  2862. 5$:     dbcc    d2,6$
  2863.         bra     7$
  2864.                                 | troisieme boucle:recopie fin i2
  2865. 8$:     movl    a2@-,a0@-
  2866. 7$:     dbra    d2,8$
  2867.         movl    sp@+,a0         | depilage adresse resultat
  2868.         movw    a0@(2),d1       | d1.w contient lon eff du resultat
  2869.         moveq   #0,d2
  2870.         movw    d1,d2           | d2.w idem
  2871.         addql   #8,a0           | a0 pointe mantisse resultat
  2872. 9$:     tstl    a0@+
  2873.         dbne    d1,9$           | chasse aux '0' partie gauche resultat
  2874.         subql   #4,a0           | a0 pointe 1er long mot non nul
  2875.         movl    d1,a0@-         | mise a jour longueur effective
  2876.         movb    d7,a0@          | mise a jour signe
  2877.         movw    d1,a0@-         | mise a jour longueur totale
  2878.         movw    #0x101,a0@-     | mise a jour type et peres
  2879.         subw    d1,d2
  2880.         lsll    #2,d2
  2881.         addl    d2,_avma                | mise a jour pile PARI
  2882.         bra     addiif
  2883.  
  2884. #===================================================================#
  2885. #                                                                   #
  2886. #               Addition : entier court + reel = reel               #
  2887. #                                                                   #
  2888. #       entree : a7@(4) contient s2 de type S                       #
  2889. #                a7@(8) pointe sur r1 de type R                     #
  2890. #       sortie : d0 pointe sur s2 + r1 de type R (zone creee)       #
  2891. #                                                                   #
  2892. #===================================================================#
  2893.  
  2894. _addsr: link    a6,#-12         | 3 lgmots pour transformer s2 en type I
  2895.         movl    a6@(8),d1       | d1.l contient s2
  2896.         bne     1$
  2897.                                 | ici s2 = 0
  2898.         movl    #0x1000002,a6@(-12)
  2899.         movl    #2,a6@(-8)
  2900.         bra     3$
  2901.                                 | ici s2 <> 0
  2902. 1$:     bmi     2$
  2903.         movl    #0x1000003,a6@(-12)
  2904.         movl    #0x1000003,a6@(-8)
  2905.         movl    d1,a6@(-4)
  2906.         bra     3$
  2907.                                 | ici s2 < 0
  2908. 2$:     movl    #0x1000003,a6@(-12)
  2909.         movl    #0xff000003,a6@(-8)
  2910.         negl    d1
  2911.         movl    d1,a6@(-4)
  2912. 3$:     movl    a6@(12),sp@-
  2913.         pea     a6@(-12)
  2914.         bsr     _addir
  2915.         unlk    a6
  2916.         rts     
  2917.         
  2918. #===================================================================#
  2919. #                                                                   #
  2920. #               Addition : entier + reel = reel                     #
  2921. #                                                                   #
  2922. #       entree : a7@(4) pointe sur i2 de type I                     #
  2923. #                a7@(8) pointe sur r1 de type R                     #
  2924. #       sortie : d0 pointe sur i2 + r1 de type R (zone creee)       #
  2925. #       precision : si exp2>=exp1 , L = L1 + int((exp2-exp1)/32) + 1#
  2926. #                   si exp2<exp1  , L = L1                          #
  2927. #                   i2 est transforme en un reel                    #
  2928. #                                                                   #
  2929. #===================================================================#
  2930.  
  2931. _addir: link    a6,#-4          | var. locale pour copie i2 en r2
  2932.         moveml  d2-d3/a2,sp@-
  2933.         movl    a6@(8),a2
  2934.         movl    a6@(12),a1      | a1,a2 pointent sur r1,i2
  2935.         tstb    a2@(4)
  2936.         bne     1$
  2937.                                 | ici i2 = 0 ( i2 + r1 = r1)
  2938. 6$:     movw    a1@(2),d0
  2939.         bsr     getr
  2940.         movl    a0,a6@(-4)      | sauve adresse resultat
  2941.         addql   #4,a1
  2942.         addql   #4,a0
  2943.         subqw   #2,d0
  2944.                                 | boucle de copie d'un reel
  2945. 4$:     movl    a1@+,a0@+
  2946.         dbra    d0,4$
  2947.         bra     addirf
  2948.                                 | ici i2 <> 0
  2949. 1$:     tstb    a1@(4)
  2950.         bne     3$
  2951.                                 | ici r1 = 0 (i2 + r1 = i2)
  2952.         movl    a1@(4),d1
  2953.         subl    #0x800000,d1
  2954.         asrl    #5,d1
  2955.         moveq   #0,d0
  2956.         movw    a2@(6),d0
  2957.         subl    d1,d0           | d0.l contient L2-[exp1/32]
  2958.         cmpl    #3,d0
  2959.         bcs     2$
  2960.         cmpl    #0x8000,d0
  2961.         bcc     2$
  2962.         bsr     getr
  2963.         movl    a0,a6@(-4)
  2964.         movl    a0,sp@-
  2965.         movl    a2,sp@-
  2966.         bsr     _affir          | le resultat est i2 en type R
  2967.         addql   #8,sp           | de longueur L2-[exp1/32]
  2968.         bra     addirf
  2969.                                 | ici i2 et r1 <> 0
  2970. 3$:     movl    a2@(8),d0
  2971.         bfffo   d0{#0:#0},d1    | d1.l recoit nb de shifts (=s)
  2972.         moveq   #0,d0
  2973.         movw    a2@(6),d0
  2974.         subqw   #2,d0
  2975.         lsll    #5,d0
  2976.         subl    d1,d0
  2977.         subql   #1,d0           | d0.l recoit 32*L2-s-1 = exp2
  2978.         moveq   #0,d3
  2979.         movw    a1@(2),d3       | d3.w recoit l1
  2980.         movl    a1@(4),d2
  2981.         andl    #0xffffff,d2
  2982.         subl    #0x800000,d2    | d2.l recoit exp1
  2983.         subl    d0,d2           | d2.l recoit exp1-exp2
  2984.         ble     5$
  2985.                                 | ici exp1 > exp2
  2986.         lsrl    #5,d2           | d2.l recoit L3=[(exp1-exp2)/32]
  2987.         subl    d2,d3           | d3.l recoit L1-L3+2
  2988.         cmpl    #2,d3
  2989.         ble     6$              | si L1 <= L3 alors:r1+i2=r1
  2990.                                 | ici L1 > L3
  2991. 7$:     movl    _avma,sp@-      | empilage pile PARI
  2992.         movw    d3,d0
  2993.         bsr     getr            | allocation memoire L1-L3+2 lg mots
  2994.                                 | pour ecrire i2 en type R
  2995.         movl    a0,sp@-         | empilage r2 (copie de i2)
  2996.         movl    a2,sp@-         | empilage i2
  2997.         bsr     _affir
  2998.         movl    a1,sp@          | empilage r1
  2999.         bsr     _addrr
  3000.         movl    d0,a0           | a0 pointe sur r2 + r1
  3001.         movw    a0@(2),d0       | d0.w contient lr (longueur resultat)
  3002.         subqw   #1,d0           | d0.w contient lr-1 (compteur pile)
  3003.         movl    sp@(4),a1       | a1 pointe sur r2
  3004.         addql   #8,sp           | depilage r1 et r2
  3005.         moveq   #0,d1
  3006.         movw    a1@(2),d1
  3007.         lsll    #2,d1           | d1.l contient 4*l2 (nb d'octets a 
  3008.                                 | desallouer dans pile PARI)
  3009.  
  3010.         movl    sp@+,a0         | a0 pointe sur ancien _avma
  3011.                                 | boucle de transfert du resultat
  3012. 8$:     movl    a1@-,a0@-
  3013.         dbra    d0,8$
  3014.         addl    d1,_avma        | mise a jour pile PARI
  3015.         movl    a0,a6@(-4)
  3016.         bra     addirf
  3017.                                 | ici exp1 <= exp2
  3018. 5$:     negl    d2
  3019.         lsrl    #5,d2           | d2.l recoit L3=[(exp2-exp1)/32]
  3020.         addw    d2,d3
  3021.         addqw   #1,d3           | d3.w recoit L1+L3+1
  3022.         cmpw    #0x8000,d3
  3023.         bcs     7$
  3024.                                 | ici debordement
  3025. 2$:     movl    #adder3,sp@-
  3026.         jsr     _err
  3027. addirf: movl    a6@(-4),d0      | d0 pointe sur resultat
  3028.         moveml  sp@+,d2-d3/a2
  3029.         unlk    a6
  3030.         rts
  3031.  
  3032. #===================================================================#
  3033. #                                                                   #
  3034. #               Addition : reel + reel = reel                       #
  3035. #                                                                   #
  3036. #       entree : a7@(4) pointe sur r2 de type R                     #
  3037. #                a7@(8) pointe sur r1 de type R                     #
  3038. #       sortie : d0 pointe sur r2 + r1 de type R (zone creee)       #
  3039. #       precision : L = inf ( L2 , L1 + [(exp2-exp1)/32])           #
  3040. #                       si exp2 >= exp1 (sinon echanger r1 et r2)   #
  3041. #                                                                   #
  3042. #===================================================================#
  3043.  
  3044. _addrr: link    a6,#-16
  3045.         moveml  d2-d7/a2-a4,sp@-
  3046.         movl    a6@(8),a2       | a2 pointe sur r2
  3047.         movl    a6@(12),a1      | a1 pointe sur r1
  3048.         tstb    a2@(4)
  3049.         bne     1$
  3050.                                 | ici r2 = 0 (r2 + r1 = r1)
  3051. 4$:     tstb    a1@(4)
  3052.         bne     22$
  3053.                                 | ici r2=r1=0
  3054.         movl    a1@(4),d1
  3055.         cmpl    a2@(4),d1
  3056.         bgt     23$
  3057.         movl    a2@(4),d1       | d1.l contient sup(fexp1,fexp2)
  3058. 23$:    moveq   #3,d0
  3059.         bsr     getr
  3060.         movl    a0,a6@(-8)
  3061.         movl    d1,a0@(4)
  3062.         clrl    a0@(8)
  3063.         bra     addrrf
  3064.                                 | ici r2 = 0 et r1 <> 0
  3065. 22$:    moveq   #0,d0
  3066.         movl    a2@(4),d2       | d2.l contient fexp2
  3067.         movl    a1@(4),d1
  3068.         andl    #0xffffff,d1    | d1.l contient fexp1
  3069.         subl    d2,d1           | d1.l recoit exp1-exp2
  3070.         bcc     24$
  3071.                                 | ici exp2 >= exp1
  3072.         moveq   #3,d0
  3073.         bsr     getr
  3074.         movl    a0,a6@(-8)      | le resultat est 0 avec exposant fexp2
  3075.         movl    a2@(4),a0@(4)
  3076.         clrl    a0@(8)
  3077.         bra     addrrf
  3078.                                 | ici exp2 < exp1
  3079. 24$:    lsrl    #5,d1           | d1.l contient [(exp1-exp2)/32]
  3080.         movw    a1@(2),d0
  3081.         subqw   #2,d0           | d0.l contient L1
  3082.         cmpl    d1,d0
  3083.         ble     25$
  3084.         movl    d1,d0           | d0.l=inf(L1,[(e1-e2)/32])=L
  3085.         addql   #1,d0           | le resultat est r1 en longueur:
  3086. 25$:    addql   #2,d0           | L1 si L1<=[(e1-e2)/32] ou
  3087.         bsr     getr
  3088.         movl    a0,a6@(-8)
  3089.         addql   #4,a1
  3090.         addql   #4,a0
  3091.         subqw   #2,d0
  3092. 27$:    movl    a1@+,a0@+
  3093.         dbra    d0,27$
  3094.         bra     addrrf
  3095.                                 | ici r2 <> 0
  3096. 1$:     tstb    a1@(4)
  3097.         bne     3$
  3098.                                 | ici r1 = 0 (r2 + r1 = r2)
  3099.         exg     a2,a1
  3100.         bra     22$
  3101.                                 | ici r1 * r2 <> 0
  3102. 3$:     movb    a1@(4),d3
  3103.         movb    a2@(4),d5
  3104.         eorb    d5,d3           | d3.b contient : 0 si r1 * r2 > 0
  3105.                                 | et est negatif sinon
  3106.         movb    d3,a6@(-2)      | sauvegarde du 'signe'
  3107.         movl    a2@(4),d3
  3108.         andl    #0xffffff,d3    | d3.l contient fexp2=e2
  3109.         movl    a1@(4),d1
  3110.         andl    #0xffffff,d1    | d1.l contient fexp1=e1
  3111.         subl    d1,d3           | d3.l  contient exp2-exp1
  3112.         beq     5$              | si e2 = e1
  3113.         bcc     6$              | si e2 > e1
  3114.                                 | ici e2 < e1
  3115.         exg     a1,a2
  3116.         negl    d3              | d3.l recoit e1-e2 > 0
  3117.                                 | ici e2-e1 > 0
  3118. 6$:     movw    d3,d4
  3119.         andw    #31,d4
  3120.         lsrl    #5,d3           | e2-e1=32*L3+r ; d4.w,d3.l recoit r,L3
  3121.         moveq   #0,d2
  3122.         movw    a2@(2),d2
  3123.         subqw   #2,d2           | d2.l recoit L2
  3124.         cmpl    d2,d3
  3125.         bcs     7$
  3126.                                 | ici L3 >= L2 (r1 + r2 = r2)
  3127.         movw    a2@(2),d0
  3128.         bsr     getr
  3129.         movl    a0,a6@(-8)
  3130.         addql   #4,a2
  3131.         addql   #4,a0
  3132.         subqw   #2,d0
  3133. 28$:    movl    a2@+,a0@+
  3134.         dbra    d0,28$
  3135.         bra     addrrf
  3136.                                 | ici L3 < L2
  3137. 7$:     moveq   #0,d1
  3138.         movw    a1@(2),d1
  3139.         subqw   #2,d1           | d1.l recoit L1
  3140.         movl    d3,d5
  3141.         addl    d1,d5           | d5.l recoit L1 + L3
  3142.         cmpl    d2,d5
  3143.         bcs     8$              | si L1 + L3 < L2
  3144.                                 | ici L3 < L2 <= L1 + L3
  3145.         movb    #1,a6@(-4)      | a6@(-4) flag contenant :
  3146.                                 | 0 si L1+L3 < L2 faire alors copie r1
  3147.                                 | 1 si L3 < L2 <= L1+L3 et idem
  3148.                                 | 2 si e1 = e2 et alors pas de copie
  3149.         movw    d2,d0
  3150.         addqw   #2,d0           | d0.w recoit l2
  3151.         bsr     getr            | allocation L2+2 lgmots pour resultat
  3152.         movl    a0,a6@(-8)      | adresse resultat dans var. locale
  3153.         movw    d2,d5
  3154.         subw    d3,d5           | d5.w contient L2 - L3
  3155.         movw    d5,d0
  3156.         addqw   #1,d0           | d0.w contient L2 - L3 + 1
  3157.         bsr     getr            | allocation L2-L3+1 pour copie r1 avec
  3158.                                 | un unique longmot code
  3159.         subqw   #2,d0           | d0.w contient L2 - L3 - 1
  3160.         movw    a2@(2),d1
  3161.         lea     a2@(0,d1:w:4),a2| a2 pointe fin de r2
  3162.         bra     9$
  3163.                                 | ici L1 + L3 < L2
  3164. 8$:     clrb    a6@(-4)         | a6@(-4) mis a 0
  3165.         movw    d5,d0
  3166.         addqw   #3,d0           | d0.w contient L1 + L3 + 3
  3167.         bsr     getr            | allocation pour resultat
  3168.         movl    a0,a6@(-8)      | adresse resultat dans var. locale
  3169.         lea     a2@(0,d0:w:4),a2| a2 pointe ou necessaire !!
  3170.         movw    a1@(2),d5       | d5.w contient L1 + 2
  3171.         movw    d5,d0           | d0.w contient L1 + 2
  3172.         subqw   #2,d5           | d5.w contient L1
  3173.         bsr     getr            | allocation L1+2 pour copie r1 avec
  3174.                                 | un  seul lgmot code
  3175.         subqw   #3,d0           | d0.w contient L1 - 1
  3176. 9$:     movl    a0,a6@(-12)     | adresse copie r1 dans var. locale
  3177.         addql   #4,a0
  3178.         movl    a0,a3           | a0 et a3 pointent sur debut copie
  3179.         addql   #8,a1           | a1 pointe debut mantisse r1
  3180. 29$:    movl    a1@+,a0@+
  3181.         dbra    d0,29$          | boucle copie r1
  3182.         tstw    d4              | test de r = nb de shifts
  3183.         bne     10$
  3184.                                 | ici r = 0 ; pas de shift a faire
  3185.                                 | a0 pointe fin copie r1
  3186.                                 | a3 pointe debut mantisse copie r1
  3187.         moveq   #0,d7
  3188.         movw    a3@(-2),d7
  3189.         subqw   #1,d7           | d7.w contient longueur mantisse copie
  3190.         movw    d7,d2
  3191.         subqw   #1,d2           | d2.w = compteur boucle addition
  3192.         lea     a3@(0,d7:w:4),a3| a3 pointe fin copie r1
  3193.         movl    a3,a1           | a1 aussi
  3194.         bra     11$
  3195.                                 | ici r <> 0 ; shift a faire
  3196. 10$:    subqw   #1,d5
  3197.         movew   d5,d2           | d5.w et d2.w = compteur boucle shift
  3198.         movl    #-1,d6
  3199.         lsrl    d4,d6           | masque de shift:0...01...1; avec r '0'
  3200.         moveq   #0,d0
  3201.                                 | boucle de shift de copie de r1
  3202. 12$:    movl    a3@,d7
  3203.         rorl    d4,d7
  3204.         movl    d7,d1
  3205.         andl    d6,d1
  3206.         subl    d1,d7
  3207.         addl    d1,d0
  3208.         movl    d0,a3@+
  3209.         movl    d7,d0
  3210.         dbra    d5,12$
  3211.         movl    a3,a1
  3212.         tstb    a6@(-4)
  3213.         bne     11$             | si a6@(-4) <> 0
  3214.                                 | ici a6@(-4) = 0
  3215.         movl    d0,a1@+
  3216.         addqw   #1,d2           | d2.w = compteur boucle addition
  3217. 11$:    movl    a6@(-8),a0      | a0 pointe sur resultat
  3218.         moveq   #0,d1
  3219.         movw    a0@(2),d1
  3220.         lea     a0@(0,d1:w:4),a0| a0 pointe fin du resultat
  3221.         bra     14$
  3222.                                 | ici e1 = e2
  3223. 5$:     movb    #2,a6@(-4)      | a6@(-4) recoit 2
  3224.         movl    d1,a6@(-16)     | a6@(-16) recoit e1=e2 biaise
  3225.         movw    a1@(2),d0
  3226.         cmpw    a2@(2),d0
  3227.         bcs     15$
  3228.         movw    a2@(2),d0
  3229. 15$:    bsr     getr            | allocation inf (l1,l2) pour resultat
  3230.         movl    a0,a6@(-8)      | adresse du resultat dans var. locale
  3231.         moveq   #0,d2
  3232.         movw    d0,d2
  3233.         movl    d2,d0
  3234.         subqw   #3,d2
  3235.         moveq   #0,d3
  3236.         movl    a2,a4
  3237.         movl    a1,a3
  3238.         lea     a0@(0,d0:w:4),a0| a0 pointe fin resultat
  3239.         lea     a1@(0,d0:w:4),a1| a1 pointe fin de r1 ou copie
  3240.         lea     a2@(0,d0:w:4),a2| a2 pointe fin de r2
  3241.  
  3242.                                 | zone des boucles d'addition
  3243.  
  3244.                                 | conditions initiales :
  3245.                                 | a0 pointe fin resultat
  3246.                                 | a1 pointe fin r1 ou copie
  3247.                                 | a2 pointe fin r2
  3248.                                 | d2.w contient L4-1
  3249.                                 | d3.w contient L3 avec L3+L4=long.res.
  3250. 14$:    subl    d4,d4           | initialisation bit X
  3251.         tstb    a6@(-2)         | test du signe de r1*r2
  3252.         bne     surr
  3253.                                 | ici r1 * r2 > 0
  3254.                                 | 1ere boucle d'addition
  3255. 16$:    movl    a1@-,d1
  3256.         movl    a2@-,d5
  3257.         addxl   d5,d1
  3258.         movl    d1,a0@-
  3259.         dbra    d2,16$
  3260.         roxrw   d4,d0           | remise a jour du bit C
  3261.         bcc     17$             | si pas de carry
  3262.         bra     18$             | si carry
  3263.                                 | 2eme boucle:propagation carry
  3264. 19$:    movl    a2@-,d5
  3265.         addxl   d4,d5
  3266.         movl    d5,a0@-
  3267.         roxrw   d4,d0           | mise a jour bit C
  3268. 18$:    dbcc    d3,19$
  3269.         bcs     20$             | si carry finale
  3270.         bra     17$
  3271.                                 | 3eme boucle:recopie reste mantisse r2
  3272. 30$:    movl    a2@-,a0@-
  3273. 17$:    dbra    d3,30$
  3274.         movl    a2@-,a0@-       | mise signe et exposant:celui de r2
  3275.         cmpb    #2,a6@(-4)
  3276.         beq     addrrf          | si a6@(-4) = 2
  3277.                                 | ici rendre copie de r1
  3278.         movl    a6@(-12),a0
  3279.         bsr     giv
  3280.         bra     addrrf
  3281.                                 | ici carry finale
  3282. 20$:    movl    a2@-,d1
  3283.         andl    #0xffffff,d1
  3284.         addql   #1,d1           | d1.l recoit fexp resultat
  3285.         cmpl    #0x1000000,d1
  3286.         blt     2$
  3287.                                 | ici fexp>=2^24 : erreur
  3288.         movl    #adder4,sp@-
  3289.         jsr     _err
  3290.                                 | ici non debordement
  3291. 2$:     cmpb    #2,a6@(-4)
  3292.         beq     13$
  3293.                                 | ici rendre copie de r1
  3294.         movl    a0,a3
  3295.         movl    a6@(-12),a0
  3296.         bsr     giv
  3297.         movl    a3,a0
  3298. 13$:    movl    d1,a0@(-4)
  3299.         movb    a2@,a0@(-4)     | mise a jour exp et sign resultat
  3300.         movw    a0@(-6),d2
  3301.         subqw   #3,d2           | compteur de shift
  3302.         movw    #-1,d0
  3303.         movw    d0,cc           | mise a 1 des bit x et c
  3304. 31$:    roxrw   a0@+
  3305.         roxrw   a0@+            | boucle de mise de retenue finale et
  3306.         dbra    d2,31$          | shift de 1 vers la droite mantisse
  3307. addrrf: movl    a6@(-8),d0      | d0 pointe sur resultat
  3308.         moveml  sp@+,d2-d7/a2-a4
  3309.         unlk    a6
  3310.         rts
  3311.                                 | ici faire une soustraction
  3312.                                 | pour conditions initiales cf.plus haut
  3313. surr:   moveq   #0,d6
  3314.         movw    d2,d6
  3315.         movw    d2,d7
  3316.         addw    d3,d7
  3317.         addqw   #3,d7
  3318.         cmpb    #2,a6@(-4)
  3319.         bne     1$
  3320.                                 | ici e2 = e1:comparer les mantisses
  3321.         addql   #8,a3
  3322.         addql   #8,a4
  3323. 12$:    cmpml   a3@+,a4@+
  3324.         dbne    d2,12$
  3325.         bhi     1$              | si |r2| > |r1|
  3326.         bne     2$              | si |r2| < |r1|
  3327.                                 | ici |r2| = |r1| et donc r2 + r1 = 0
  3328.         movl    a6@(-8),a0      | le resultat est 0 avec comme exposant
  3329.         moveq   #0,d2           | -32*inf(l1,l2)+e1
  3330.         movw    a0@(2),d2
  3331.         subqw   #2,d2
  3332.         lsll    #5,d2   
  3333.         negl    d2
  3334.         addl    a6@(-16),d2     | ajouter e1 biaise
  3335.         bpl     15$
  3336.         movl    #adder5,sp@-    | underflow dans R+R
  3337.         jsr     _err
  3338. 15$:    cmpl    #0x1000000,d2
  3339.         blt     16$
  3340.                                 | ici fexp>=2^24 : erreur overflow dans R+R
  3341.         movl    #adder4,sp@-
  3342.         jsr     _err
  3343. 16$:    bsr     giv
  3344.         moveq   #3,d0
  3345.         bsr     getr
  3346.         movl    a0,a6@(-8)
  3347.         movl    d2,a0@(4)
  3348.         clrl    a0@(8)
  3349.         bra     addrrf
  3350.                                 | ici |r2| < |r1| : echanger r2 et r1
  3351. 2$:     exg     a1,a2
  3352.                                 | ici |r2| > |r1|
  3353. 1$:     subw    d2,d6
  3354.         subl    d4,d4           | initialisation bit X
  3355.                                 | 1ere boucle de soustraction
  3356. 3$:     movl    a2@-,d0
  3357.         movl    a1@-,d5
  3358.         subxl   d5,d0
  3359.         movl    d0,a0@-
  3360.         dbra    d2,3$
  3361.         roxrw   d4,d0           | remise ajour bit C
  3362.         bra     4$
  3363.                                 | 2eme boucle:propagation carry
  3364. 5$:     movl    a2@-,d5
  3365.         subxl   d4,d5
  3366.         movl    d5,a0@-
  3367.         roxrw   d4,d0
  3368. 4$:     dbcc    d3,5$
  3369.         bra     6$
  3370.                                 | 3eme boucle:copie reste mantisse r2
  3371. 13$:    movl    a2@-,a0@-
  3372. 6$:     dbra    d3,13$
  3373.         moveq   #0,d3
  3374.         moveq   #-1,d2
  3375.         movw    d2,d3
  3376. 14$:    tstl    a0@+
  3377.         dbne    d2,14$          | chasse aux '0' du resultat provisoire
  3378.                                 | a0 pointe sur 1er lgmot non nul
  3379.         subw    d2,d3           | d3.w  contient de lgmots nuls
  3380.         addw    d6,d3
  3381.         subl    #12,a0          | a0 pointe sur resultat
  3382.         movl    a0,a6@(-8)
  3383.         movl    a0,a1           | a1 aussi
  3384.         cmpb    #2,a6@(-4)
  3385.         beq     7$              | si pas de copie faite
  3386.                                 | ici rendre copie
  3387.         movl    a6@(-12),a0
  3388.         bsr     giv
  3389. 7$:     moveq   #0,d0
  3390.         movw    d3,d0
  3391.         lsll    #2,d0           | d0.l = nb d'octets a 0 du result.
  3392.         addl    d0,_avma        | mise a jour pile PARI(rendre d3 lgmot)
  3393.         movl    a1,a0           | a0 pointe sur resultat final
  3394.         movw    #0x201,a0@
  3395.         subw    d3,d7
  3396.         movw    d7,a0@(2)       | mise a jour 1er lgmot code resultat
  3397.         lsll    #5,d3
  3398.         movl    a0@(8),d0
  3399.         bfffo   d0{#0:#0},d1    | d1.l contient nb de shifts=r
  3400.         lsll    d1,d0           | normalisation 1er lgmot mantisse
  3401.         addl    d1,d3
  3402.         lsll    #2,d6
  3403.         subl    d6,a2
  3404.         movl    a2@(-4),d2
  3405.         andl    #0xffffff,d2
  3406.         subl    d3,d2
  3407.         movl    d2,a0@(4)       | calcul et mise exposant resultat
  3408.         movb    a2@(-4),a0@(4)  | mise signe resultat
  3409.         tstb    d1
  3410.         bne     8$              | si r <> 0
  3411.         bra     9$              | si r = 0
  3412. 8$:     moveq   #1,d6
  3413.         lsll    d1,d6
  3414.         subql   #1,d6           | masque de shift
  3415.         addql   #8,a1
  3416.         subqw   #3,d7           | d7.w  contient L-1
  3417.         bra     10$
  3418.                                 | boucle de shift vers la gauche
  3419. 11$:    movl  a1@(4),d2
  3420.         roll    d1,d2
  3421.         movl    d2,d3
  3422.         andl    d6,d3
  3423.         subl    d3,d2
  3424.         addl    d3,d0
  3425.         movl    d0,a1@+
  3426.         movl    d2,d0
  3427. 10$:    dbra    d7,11$
  3428.         movl    d0,a1@
  3429. 9$:     bra     addrrf
  3430.  
  3431.  
  3432.  
  3433.  
  3434.  
  3435. #*******************************************************************#
  3436. #*******************************************************************#
  3437. #**                                                               **#
  3438. #**                     PROGRAMMES DE SOUSTRACTION                **#
  3439. #**                                                               **#
  3440. #*******************************************************************#
  3441. #*******************************************************************#
  3442.  
  3443.  
  3444.  
  3445.  
  3446.  
  3447. #===================================================================#
  3448. #                                                                   #
  3449. #                       Soustraction generale                       #
  3450. #                                                                   #
  3451. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  3452. #                a7@(8) pointe sur n1 de type I ou R                #
  3453. #       sortie : d0 pointe sur n2 - n1 de type I ou R (zone creee)  #
  3454. #       interdit : type S                                           #
  3455. #                                                                   #
  3456. #===================================================================#
  3457.  
  3458. _mpsub: cmpb    #1,sp@(8)@
  3459.         bne     1$
  3460.         cmpb    #1,sp@(4)@
  3461.         beq     _subii
  3462.         bra     _subri
  3463. 1$:     cmpb    #1,sp@(4)@
  3464.         beq     _subir
  3465.         bra     _subrr
  3466.  
  3467. #===================================================================#
  3468. #                                                                   #
  3469. #                       Soustraction (par valeur)                   #
  3470. #                                                                   #
  3471. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  3472. #                a7@(8) pointe sur n1 de type I ou R                #
  3473. #                a7@(12) pointe sur n3 de type I ou R               #
  3474. #       sortie : la zone pointee par a7@(12) contient n2 - n1       #
  3475. #       interdit : type S                                           #
  3476. #                                                                   #
  3477. #===================================================================#
  3478.  
  3479. _mpsubz:lea     _mpsub,a0
  3480.         bra     mpopz
  3481.  
  3482.                                 | soustraction S-S=I ou R
  3483.  
  3484. _subssz:lea     _subss,a0
  3485.         bra     mpopz
  3486.  
  3487.                                 | soustraction S-I=I ou R
  3488.  
  3489. _subsiz:lea     _subsi,a0
  3490.         bra     mpopz
  3491.  
  3492.                                 | soustraction S-R=R sinon erreur
  3493.  
  3494. _subsrz:lea     _subsr,a0
  3495.         bra     mpopz
  3496.  
  3497.                                 | soustraction I-S=I ou R
  3498.  
  3499. _subisz:lea     _subis,a0
  3500.         bra     mpopz
  3501.  
  3502.                                 | soustraction I-I=I ou R
  3503.  
  3504. _subiiz:lea     _subii,a0
  3505.         bra     mpopz
  3506.  
  3507.                                 | soustraction I-R=R sinon erreur
  3508.  
  3509. _subirz:lea     _subir,a0
  3510.         bra     mpopz
  3511.  
  3512.                                 | soustraction R-S=R sinon erreur
  3513.  
  3514. _subrsz:lea     _subrs,a0
  3515.         bra     mpopz
  3516.  
  3517.                                 | soustraction R-I=R sinon erreur
  3518.  
  3519. _subriz:lea     _subri,a0
  3520.         bra     mpopz
  3521.  
  3522.                                 | soustraction R-R=R sinon erreur
  3523.  
  3524. _subrrz:lea     _subrr,a0
  3525.         bra     mpopz
  3526.  
  3527. #===================================================================#
  3528. #                                                                   #
  3529. #       Soustraction : entier court - entier court = entier         #
  3530. #                                                                   #
  3531. #       entree : a7@(4) contient s2 de type S                       #
  3532. #                a@7(8) contient s1 de type S                       #
  3533. #       sortie : d0 pointe sur s2 - s1 de type I (zone creee)       #
  3534. #       remarque : s2 - s1 = s0 est interdit                        #
  3535. #                                                                   #
  3536. #===================================================================#
  3537.  
  3538. _subss: link    a6,#-12
  3539.         movl    a6@(12),d1      | d1.l recoit s1
  3540.         negl    d1              | d1.l recoit -s1
  3541.         bvs     1$
  3542.                                 | ici |s1| <= 2^31-1
  3543.         movl    d1,sp@-         | empilage -s1
  3544.         movl    a6@(8),sp@-     | empilage s2
  3545.         bsr     _addss          | calcul se s2+(-s1)
  3546.         bra     subssf
  3547.                                 | ici s1 = -2^31
  3548. 1$:     movl    #0x1000003,a6@(-12)
  3549.         movl    #0x1000003,a6@(-8)
  3550.         movl    #0x80000000,a6@(-4)| creation de 2^31 type entier
  3551.         pea     a6@(-12)        | empilage adresse de 2^31
  3552.         movl    a6@(8),sp@-     | empilage s2
  3553.         bsr     _addsi
  3554. subssf: unlk    a6
  3555.         rts
  3556.  
  3557. #===================================================================#
  3558. #                                                                   #
  3559. #               Soustraction : entier - entier = entier             #
  3560. #                                                                   #
  3561. #       entree : a7@(4) pointe sur i2 de type I                     #
  3562. #                a7@(8) pointe sur i1 de type I                     #
  3563. #       sortie : d0 pointe sur i2 - i1 de type I (zone creee)       #
  3564. #                                                                   #
  3565. #===================================================================#
  3566.  
  3567. _subii: link    a6,#-4
  3568.         movl    a6@(12),sp@-    | empilage adresse i1
  3569.         movl    a6@(8),sp@-     | empilage adresse i2
  3570.         movl    a6@(12),a0      | a0 pointe sur i1
  3571.         negb    a0@(4)          | changer signe de i1
  3572.         movl    a0,a6@(-4)
  3573.         bsr     _addii
  3574.         movl    a6@(-4),a0
  3575.         negb    a0@(4)          | remettre signe de i1
  3576.         unlk    a6
  3577.         rts
  3578.  
  3579. #===================================================================#
  3580. #                                                                   #
  3581. #               Soustraction : reel - reel = reel                   #
  3582. #                                                                   #
  3583. #       entree : a7@(4) pointe sur r2 de type R                     #
  3584. #                a7@(8) pointe sur r1 de type R                     #
  3585. #       sortie : d0 pointe sur r2 - r1 de type R (zone creee)       #
  3586. #                                                                   #
  3587. #===================================================================#
  3588.  
  3589. _subrr: link    a6,#-4          | voir commentaires de _subii
  3590.         movl    a6@(12),sp@-
  3591.         movl    a6@(8),sp@-
  3592.         movl    a6@(12),a0
  3593.         negb    a0@(4)
  3594.         movl    a0,a6@(-4)
  3595.         bsr     _addrr
  3596.         movl    a6@(-4),a0
  3597.         negb    a0@(4)
  3598.         unlk    a6
  3599.         rts
  3600.  
  3601. #===================================================================#
  3602. #                                                                   #
  3603. #       Soustraction : entier court - entier = entier               #
  3604. #                                                                   #
  3605. #       entree : a7@(4) contient s2 de type S                       #
  3606. #                a7@(8) pointe sur i1 de type I                     #
  3607. #       sortie : d0 pointe sur s2 - i1 de type I                    #
  3608. #                                                                   #
  3609. #===================================================================#
  3610.  
  3611. _subsi: link    a6,#-4          | voir commentaires de _subii
  3612.         movl    a6@(12),sp@-
  3613.         movl    a6@(8),sp@-
  3614.         movl    a6@(12),a0
  3615.         negb    a0@(4)
  3616.         movl    a0,a6@(-4)
  3617.         bsr     _addsi
  3618.         movl    a6@(-4),a0
  3619.         negb    a0@(4)
  3620.         unlk    a6
  3621.         rts
  3622.  
  3623. #===================================================================#
  3624. #                                                                   #   
  3625. #               Soustraction : entier court - reel = reel           #
  3626. #                                                                   #
  3627. #       entree : a7@(4) contient s2 de type S                       #
  3628. #                a7@(8) pointe sur r1 de type R                     #
  3629. #       sortie : d0 pointe sur s2 - r1 de type R (zone creee)       #
  3630. #                                                                   #
  3631. #===================================================================#
  3632.  
  3633. _subsr: link    a6,#-4          | voir commentaires de _subii
  3634.         movl    a6@(12),sp@-
  3635.         movl    a6@(8),sp@-
  3636.         movl    a6@(12),a0
  3637.         negb    a0@(4)
  3638.         movl    a0,a6@(-4)
  3639.         bsr     _addsr
  3640.         movl    a6@(-4),a0
  3641.         negb    a0@(4)
  3642.         unlk    a6
  3643.         rts
  3644.  
  3645. #===================================================================#
  3646. #                                                                   #
  3647. #       Soustraction : entier - entier court = entier               #
  3648. #                                                                   #
  3649. #       entree : a7@(4) pointe sur i1 de type I                     #
  3650. #                a7@(8) contient s2 de type S                       #
  3651. #       sortie : d0 pointe sur i1 - s2 de type I (zone creee)       #
  3652. #                                                                   #
  3653. #===================================================================#
  3654.  
  3655. _subis: link    a6,#-12         | voir commentaires de _subss
  3656.         movl    a6@(8),sp@-
  3657.         movl    a6@(12),d1
  3658.         negl    d1
  3659.         bvs     1$
  3660.         movl    d1,sp@-
  3661.         bsr     _addsi
  3662.         bra     subisf
  3663. 1$:     movl    #0x1000003,a6@(-12)
  3664.         movl    #0x1000003,a6@(-8)
  3665.         movl    #0x80000000,a6@(-4)
  3666.         pea     a6@(-12)
  3667.         bsr     _addii
  3668. subisf: unlk    a6
  3669.         rts
  3670.  
  3671. #===================================================================#
  3672. #                                                                   #
  3673. #               Soustraction : entier - reel = reel                 #
  3674. #                                                                   #
  3675. #       entree : a7@(4) pointe sur i2 de type I                     #
  3676. #                a7@(8) pointe sur r1 de type R                     #
  3677. #       sortie : d0 pointe sur i2 - r1 de type R (zone creee)       #
  3678. #                                                                   #
  3679. #===================================================================#
  3680.  
  3681. _subir: link    a6,#-4          | voir commentaires de _subii
  3682.         movl    a6@(12),sp@-
  3683.         movl    a6@(8),sp@-
  3684.         movl    a6@(12),a0
  3685.         negb    a0@(4)
  3686.         movl    a0,a6@(-4)
  3687.         bsr     _addir
  3688.         movl    a6@(-4),a0
  3689.         negb    a0@(4)
  3690.         unlk    a6
  3691.         rts
  3692.  
  3693. #===================================================================#
  3694. #                                                                   #
  3695. #               Soustraction : reel - entier = reel                 #
  3696. #                                                                   #
  3697. #       entree : a7@(4) pointe sur r1 de type R                     #
  3698. #                a7@(8) pointe sur i2 de type I                     #
  3699. #       sortie : d0 pointe sur r2 - i1 de type R (zone creee)       #
  3700. #                                                                   #
  3701. #===================================================================#
  3702.  
  3703. _subri: link    a6,#-4          | voir commentaires de _subii
  3704.         movl    a6@(8),sp@-
  3705.         movl    a6@(12),sp@-
  3706.         movl    a6@(12),a0
  3707.         negb    a0@(4)
  3708.         movl    a0,a6@(-4)
  3709.         bsr     _addir
  3710.         movl    a6@(-4),a0
  3711.         negb    a0@(4)
  3712.         unlk    a6
  3713.         rts
  3714.  
  3715. #===================================================================#
  3716. #                                                                   #
  3717. #       Soustraction : reel - entier court = reel                   #
  3718. #                                                                   #
  3719. #       entree : a7@(4) pointe sur r2 de type R                     #
  3720. #                a7@(8) contient s1 de type S                       #
  3721. #       sortie : d0 pointe sur r2 - s1 de type R (zone creee)       #
  3722. #                                                                   #
  3723. #===================================================================#
  3724.  
  3725. _subrs: link    a6,#-12         | voir commentaires de _subss
  3726.         movl    a6@(8),sp@-
  3727.         movl    a6@(12),d1
  3728.         negl    d1
  3729.         bvs     1$
  3730.         movl    d1,sp@-
  3731.         bsr     _addsr
  3732.         bra     subsrf
  3733. 1$:     movl    #0x1000003,a6@(-12)
  3734.         movl    #0x1000003,a6@(-8)
  3735.         movl    #0x80000000,a6@(-4)
  3736.         pea     a6@(-12)
  3737.         bsr     _addir
  3738. subsrf: unlk    a6
  3739.         rts
  3740.  
  3741.  
  3742.  
  3743.  
  3744.  
  3745. #*******************************************************************#
  3746. #*******************************************************************#
  3747. #**                                                               **#
  3748. #**                     PROGRAMMES DE MULTIPLICATION              **#
  3749. #**                                                               **#
  3750. #*******************************************************************#
  3751. #*******************************************************************#
  3752.  
  3753.  
  3754.  
  3755.  
  3756.  
  3757. #===================================================================#
  3758. #                                                                   #
  3759. #                       Multiplication generale                     #
  3760. #                                                                   #
  3761. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  3762. #                a7@(8) pointe sur n1 de type I ou R                #
  3763. #       sortie : d0 pointe sur n2 * n1 de type I ou R (zone cree)   #
  3764. #       interdit : type S                                           #
  3765. #       precision : voir routines specialisees                      #
  3766. #                                                                   #
  3767. #===================================================================#
  3768.  
  3769. _mpmul: movl    sp@(4),a0
  3770.         movl    sp@(8),a1       | a1 et a0 pointent sur n1 et n2
  3771.         movb    a0@,d0
  3772.         movb    a1@,d1          | d1.b et d0.b contiennent T1 et T2
  3773.         cmpb    d1,d0
  3774.         ble     1$
  3775.                                 | ici T2 > T1
  3776.         exg     a1,a0
  3777.         exg     d1,d0
  3778.         movl    a0,sp@(4)
  3779.         movl    a1,sp@(8)
  3780.                                 | ici T2 <= T1
  3781. 1$:     cmpb    #1,d1
  3782.         beq     _mulii          | ici T1 = T2 = I
  3783. 2$:     cmpb    #2,d0
  3784.         beq     _mulrr          | ici T1 = T2 = R
  3785.         bra     _mulir
  3786.  
  3787. #===================================================================#
  3788. #                                                                   #
  3789. #               Multiplication (par valeur)                         #
  3790. #                                                                   #
  3791. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  3792. #                a7@(8) pointe sur n1 de type I ou R                #
  3793. #                a7@(12) pointe sur n3 de type I ou R               #
  3794. #       sortie : la zone pointee par a7@(12) contient n2*n1         #
  3795. #       interdit : type S                                           #
  3796. #                                                                   #
  3797. #===================================================================#
  3798.  
  3799. _mpmulz:lea     _mpmul,a0
  3800.         bra     mpopz
  3801.  
  3802.                                 | multiplication S*S=I ou R
  3803.  
  3804. _mulssz:lea     _mulss,a0
  3805.         bra     mpopz
  3806.  
  3807.                                 | multiplication S*I=I ou R
  3808.  
  3809. _mulsiz:lea     _mulsi,a0
  3810.         bra     mpopz
  3811.  
  3812.                                 | multiplication S*R=R sinon erreur
  3813.  
  3814. _mulsrz:lea     _mulsr,a0
  3815.         bra     mpopz
  3816.  
  3817.                                 | multiplication I*I=I ou R
  3818.  
  3819. _muliiz:lea     _mulii,a0
  3820.         bra     mpopz
  3821.  
  3822.                                 | multiplication I*R=R sinon erreur
  3823.  
  3824. _mulirz:lea     _mulir,a0
  3825.         bra     mpopz
  3826.  
  3827.                                 | multiplication R*R=R sinon erreur
  3828.  
  3829. _mulrrz:lea     _mulrr,a0
  3830.         bra     mpopz
  3831.  
  3832. #===================================================================#
  3833. #                                                                   #
  3834. #       Multiplication : entier court * entier court = entier       #
  3835. #                                                                   #
  3836. #       entree : a7@(4) contient s2 de type S                       #
  3837. #                a7@(8) contient s1 de type S                       #
  3838. #       sortie : d0 pointe sur s2 * s1 de type I (zone creee)       #
  3839. #                                                                   #
  3840. #===================================================================#
  3841.  
  3842. _mulss: link    a6,#-2
  3843.         moveml  d2-d4,sp@-
  3844.         movl    a6@(8),d2       | d2.l contient s2
  3845.         bne     1$
  3846. 2$:     movl    _gzero,d0       | ici s2 ou s1 = 0
  3847.         bra     mulssg
  3848.                                 | ici s2 <> 0
  3849. 1$:     movl    d2,d4
  3850.         bpl     3$
  3851.         negl    d2              | d2.l contient |s2|
  3852. 3$:     movl    a6@(12),d1      | d1.l contient s1
  3853.         beq     2$              | si s1=0
  3854.         eorl    d1,d4           
  3855.         tstl    d1
  3856.         bpl     4$
  3857.         negl    d1              | d1.l contient |s1|
  3858. 4$:     mulul   d1,d3:d2
  3859.         movw    #4,d0
  3860.         tstl    d3
  3861.         bne     5$
  3862.         movw    #3,d0           | d0 recoit 3 ou 4 pour allocation
  3863. 5$:     bsr     geti
  3864.         movw    a0@(2),a0@(6)   | met long effect.
  3865.         movb    #1,a0@(4)       | met signe
  3866.         tstl    d4
  3867.         bpl     6$
  3868.         negb    a0@(4)
  3869. 6$:     tstl    d3
  3870.         bne     7$
  3871.         movl    d2,a0@(8)
  3872.         bra     mulssf
  3873. 7$:     movl    d3,a0@(8)
  3874.         movl    d2,a0@(12)
  3875. mulssf: movl    a0,d0
  3876. mulssg: moveml  sp@+,d2-d4
  3877.         unlk    a6
  3878.         rts
  3879.  
  3880. #===================================================================#
  3881.  
  3882.  
  3883. _mulmodll:
  3884.     movl    sp@(4),d1
  3885.     mulul    sp@(8),d0:d1
  3886.     divul    sp@(12),d0:d1
  3887.     rts
  3888.  
  3889. #===================================================================#
  3890. #                                                                   #
  3891. #       Multiplication : entier court * entier = entier             #
  3892. #                                                                   #
  3893. #       entree : a7@(4) contient s2 de type S                       #
  3894. #                a7@(8) pointe sur i1 de type I                     #
  3895. #       sortie : d0 pointe sur s2 * i1  de type I (zone creee)      #
  3896. #                                                                   #
  3897. #===================================================================#
  3898.  
  3899. _mulsi: link    a6,#0
  3900.         moveml  d2-d6/a2,sp@-
  3901.         movl    a6@(8),d2       | d2.l contient s2
  3902.         bne     1$
  3903.                                 | ici s2 = 0 ou i1 = 0
  3904. 2$:     movl    _gzero,d0
  3905.         bra     mulsig
  3906.                                 | ici s2 <> 0
  3907. 1$:     bpl     6$
  3908.         negl    d2              | d2 contient |s2|
  3909. 6$:     movl    a6@(12),a1      | a1 pointe sur i1
  3910.         tstb    a1@(4)
  3911.         beq     2$              | si i1 = 0
  3912.                                 | ici i1 <> 0 et s2 <> 0
  3913.         movw    a1@(6),d0       | d0.w contient le1
  3914.         bsr     geti
  3915.         lea     a0@(0,d0:w:4),a2| a2 pointe apres resultat (i0)
  3916.         lea     a1@(0,d0:w:4),a1| a1 pointe apres i1
  3917.         subqw   #3,d0
  3918.         moveq   #0,d6
  3919.         moveq   #0,d5           | initialisation retenue
  3920.                                 | debut boucle multiplication
  3921. 3$:     movl    a1@-,d4
  3922.         mulul   d2,d3:d4
  3923.         addl    d5,d4
  3924.         addxl   d6,d3
  3925.         movl    d4,a2@-
  3926.         movl    d3,d5
  3927.         dbra    d0,3$
  3928.         beq     5$
  3929.                                 | ici retenue finale
  3930.         movw    #1,d0
  3931.         bsr     geti
  3932.         movw    a0@(6),d0
  3933.         addqw   #1,d0           | d0.w contient le(i0)
  3934.         bvc     4$
  3935.                                 | ici debordement
  3936.         movl    #muler3,sp@-
  3937.         jsr     _err
  3938. 4$:     movw    d0,a0@(2)       | mise longueur
  3939.         movl    d5,a0@(8)       | mise retenue
  3940. 5$:     movw    a0@(2),a0@(6)   | mise le(i0)
  3941.         movb    a1@(-4),a0@(4)
  3942.         tstl    a6@(8)
  3943.         bpl     mulsif
  3944.         negb    a0@(4)          | mise signe
  3945. mulsif: movl    a0,d0   
  3946. mulsig: moveml  sp@+,d2-d6/a2
  3947.         unlk    a6
  3948.         rts
  3949.  
  3950. #===================================================================#
  3951. #                                                                   #
  3952. #               Multiplication : entier court * reel = reel         #
  3953. #                                                                   #
  3954. #       entree : a7@(4) contient s2 de type S                       #
  3955. #                a7@(8) pointe sur r1 de type R                     #
  3956. #       sortie : d0 pointe sur s2 * r1 de type R                    #
  3957. #                        de longueur L = L1 (zone creee)            #
  3958. #                                                                   #
  3959. #===================================================================#
  3960.  
  3961. _mulsr: link    a6,#-4
  3962.         moveml  d2-d6/a2,sp@-
  3963.         movl    a6@(8),d2       | d2.l contient s2
  3964.         bne     1$
  3965.                                 | ici s2 = 0
  3966.     movl    _gzero,d0
  3967.         bra     mulsrf1
  3968.                                 | ici s2 <> 0
  3969. 1$:     movl    a6@(12),a1      | a1 pointe sur r1
  3970.         tstb    a1@(4)
  3971.         bne     2$
  3972.                                 | ici r1 = 0
  3973.         moveq   #3,d0
  3974.         bsr     getr
  3975.         tstl    d2
  3976.         bpl     2$
  3977.         negl    d2
  3978.         bfffo   d2{#0:#0},d0
  3979.         movl    a1@(4),d1
  3980.         addl    #31,d1
  3981.         subl    d0,d1
  3982.         cmpl    #0x1000000,d1
  3983.         bcc     11$
  3984.         movl    d1,a0@(4)
  3985.         clrl    a0@(8)
  3986.         movl    a0,d0
  3987.         bra     mulsrf1
  3988. 2$:     movw    a1@(2),d0
  3989.         bsr     getr            | allocation memoire pour resultat
  3990.         movl    a0,a6@(-4)      | sauvegarde adr. resultat ds var.locale
  3991.                                 | ici s2 et r1 <> 0
  3992.         movl    d2,d4
  3993.         bpl     3$
  3994.         negl    d2              | d2.l contient |s2|
  3995. 3$:     cmpl    #1,d2
  3996.         bne     4$
  3997.                                 | ici |s2| = 1
  3998.         addql   #4,a0
  3999.         addql   #4,a1
  4000.         subqw   #2,d0
  4001. 5$:     movl    a1@+,a0@+
  4002.         dbra    d0,5$           | copie de r1 dans resultat
  4003.         movl    a6@(-4),a0
  4004.         tstl    d4
  4005.         bpl     mulsrf
  4006.         negb    a0@(4)          | mise signe
  4007.         bra     mulsrf
  4008.                                 | ici |s2| <> 1 et 0 , r1 <> 0
  4009. 4$:     movb    a1@(4),a0@(4)
  4010.         tstl    d4
  4011.         bpl     6$
  4012.         negb    a0@(4)          | mise signe
  4013. 6$:     lea     a0@(0,d0:w:4),a0| a0 pointe apres resultat
  4014.         lea     a1@(0,d0:w:4),a1| a1 pointe apres r1
  4015.         subqw   #3,d0           | d0.w contient L1-1
  4016.         movw    d0,d4           | d4.w idem
  4017.         movw    d4,d6
  4018.         moveq   #0,d1           | d1 a 0 pour les addx
  4019.         moveq   #0,d0           | initialisation retenue d0
  4020.                                 | boucle de multiplication :
  4021. 7$:     movl    a1@-,d5
  4022.         mulul   d2,d3:d5
  4023.         addl    d0,d5
  4024.         addxl   d1,d3
  4025.         movl    d5,a0@-
  4026.         movl    d3,d0           | nouvelle retenue d0
  4027.         dbra    d6,7$
  4028.         bfffo   d0{#0:#0},d1    | d1.l contient nb. de shifts
  4029.         lsll    d1,d0           | normalisation de d0
  4030.         moveq   #1,d6
  4031.         lsll    d1,d6
  4032.         subql   #1,d6           | masque de shift
  4033.         negb    d1
  4034.         addb    #32,d1
  4035.                                 | boucle de shift
  4036. 8$:     movl    a0@,d2
  4037.         rorl    d1,d2
  4038.         movl    d2,d3
  4039.         andl    d6,d3
  4040.         subl    d3,d2
  4041.         addl    d3,d0
  4042.         movl    d0,a0@+
  4043.         movl    d2,d0
  4044.         dbra    d4,8$
  4045.         movl    a6@(-4),a0      | a0 pointe sur resultat
  4046.         movl    a1@(-4),d0
  4047.         andl    #0xffffff,d0    | d0.l contient fexp1
  4048.         addl    d1,d0           | d0.l contient fexp resultat
  4049.         btst    #24,d0
  4050.         beq     9$
  4051.                                 | ici debordement
  4052. 11$:    movl    #muler2,sp@-
  4053.         jsr     _err
  4054. 9$:     movw    d0,a0@(6)       | mise exposant
  4055.         swap    d0
  4056.         movb    d0,a0@(5)
  4057. mulsrf: movl    a6@(-4),d0      | adresse du resultat
  4058. mulsrf1:moveml  sp@+,d2-d6/a2
  4059.         unlk    a6
  4060.         rts
  4061.         
  4062. #===================================================================#
  4063. #                                                                   #
  4064. #               Multiplication : entier * entier = entier           #
  4065. #                                                                   #
  4066. #       entree : a7@(4) pointe sur i2 de type I                     #
  4067. #                a7@(8) pointe sur i1 de type I                     #
  4068. #       sortie : d0 pointe sur i2 * i1 de type I (zone creee)       #
  4069. #                                                                   #
  4070. #===================================================================#
  4071.  
  4072. _mulii: link    a6,#0
  4073.         moveml  d2-d7/a2-a4,sp@-
  4074.         movl    a6@(8),a1
  4075.         movl    a6@(12),a2      | a1,a2 pointent sur i1,i2
  4076.         movw    a1@(6),d1       
  4077.         movw    a2@(6),d2       | d1.w, d2.w contient l1,l2
  4078.         cmpw    d1,d2
  4079.         bcc     1$
  4080.                                 | ici l1>l2 : echanger i1 et i2
  4081.         exg     a1,a2
  4082.         exg     d1,d2           | maintenant l1<=l2
  4083. 1$:     subqw   #2,d1           | d1 recoit L1
  4084.         bne     2$
  4085.                                 | ici L1=0  <==> i1*i2 = 0
  4086. 6$:     movl    _gzero,d0       | cree resultat nul de type I
  4087.         bra     muliig
  4088.                                 | maintenant 1<=L1<=L2
  4089. 2$:     movw    d2,d0           | d0 recoit l2
  4090.         addw    d1,d0           | d0 recoit l2 + L1 = L1 + L2 + 2
  4091.         bvc     3$
  4092.         movl    #muler1,sp@-
  4093.         jsr     _err            | debordement
  4094.         bra     6$
  4095. 3$:     bsr     geti            | allocation memoire pour resultat
  4096.         movw    d0,a0@(6)       | met long effect. (peut-etre 1 de trop)
  4097.         movb    a1@(4),d3
  4098.         movb    a2@(4),d4
  4099.         eorb    d4,d3
  4100.         addqb   #1,d3
  4101.         movb    d3,a0@(4)       | met signe du resultat
  4102.         lea     a0@(0,d0:w:4),a4| a4 pointe apres fin resultat = z
  4103.         lea     a1@(8,d1:w:4),a1| a1 pointe apres fin de i1 = y
  4104.         lea     a2@(0,d2:w:4),a3| a3 pointe apres fin de i2 = x
  4105.         subqw   #1,d1           | d1 recoit L1-1 compt bcl externe
  4106.         subqw   #3,d2           | d2 recoit L2-1 compt bcl interne
  4107.         movw    d2,d0           | sauvegarde compt interne dans d0
  4108.         moveq   #0,d7           | registre d7 fixe a 0
  4109.                                 | Boucles de multiplication I*I :
  4110. | x=x1x2...xn multiplicande (x=i2,n=L2) pointe par a2 et a3
  4111. | y=y1...ym multiplicateur (y=i1,m=L1) pointe par a1
  4112. | z=z1z2...z(n+m) resultat pointe par a0 et a4
  4113. | a0 et a2 sont decrementes par la boucle interne (les valeurs initiales
  4114. | etant conservees dans a4 et a3)
  4115. #...................................................................#
  4116.                                 | 1re boucle interne:initialise resultat
  4117.                                 | (z recoit x*ym)
  4118.         movl    a3,a2           | a2 pointe apres xn
  4119.         movl    a4,a0           | a0 pointe apres z(n+m)
  4120.         movl    a1@-,d3         | d3 recoit ym
  4121.     subl    d4,d4           | d4 retenue k et X initialise a 0
  4122. m1:    movl    d4,d6        | nouvelle retenue dans d6
  4123.     movl    d3,d5        | dupliquer le multiplicateur
  4124.         mulul   a2@-,d4:d5      | d4:d5 recoit xi*ym (i=n,n-1,...,1)
  4125.         addxl   d5,d6
  4126.         addxl   d7,d4           | d4:d5 recoit xi*ym + k
  4127.         movl    d6,a0@-         | range z(i+m)
  4128.         dbra    d2,m1           | fin 1re bcl interne
  4129.         bra     bclf            | brancher fin de boucle externe
  4130. mext:   subql   #4,a4           | a4 pointe apres z(n+i)
  4131.         movl    a3,a2           | a2 pointe apres xn
  4132.         movl    a4,a0           | a0 pointe apres z(n+i)
  4133.         movl    d0,d2           | d2 recoit n-1 compteur bcl interne
  4134.         movl    a1@-,d3         | d3 recoit yj (j=m-1,m-2...1)
  4135.     subl    d4,d4           | d4 retenue k et X initialise a 0
  4136. mint:    movl    d4,d6        | nouvelle retenue dans d6
  4137.     movl    d3,d5        | dupliquer le multiplicateur
  4138.         mulul   a2@-,d4:d5      | d4:d5 recoit xi*yj (i=n,n-1,...,1)
  4139.         addxl   d5,d6
  4140.         addxl   d7,d4           | d4:d5 recoit xi*yj + k
  4141.         addl    d6,a0@-         | range partie basse de xi*yj+z(i+j)+k
  4142.         dbra    d2,mint         | fin de boucle interne
  4143.     addxl    d7,d4
  4144. bclf:   movl    d4,a0@-         | range derniere retenue
  4145.         dbra    d1,mext         | fin bcl externe
  4146. #...................................................................#
  4147.                                 | derniere retenue = 0 ?
  4148.         beq     4$
  4149.         subql   #8,a0           | non : rien a faire
  4150.                                 | a0 pointe sur resultat
  4151.         bra     muliif
  4152.                                 | ici pas de retenue finale
  4153. 4$:     subqw   #1,a0@(-2)
  4154.         subqw   #1,a0@(-6)      | rectifier longueurs
  4155.         movl    a0@(-4),a0@     | deplacer mots codes
  4156.         movl    a0@(-8),a0@-    | a0 pointe sur resultat
  4157.         addl    #4,_avma
  4158. muliif: movl    a0,d0
  4159. muliig: moveml  sp@+,d2-d7/a2-a4
  4160.         unlk    a6
  4161.         rts
  4162.  
  4163. #===================================================================#
  4164. #                                                                   #
  4165. #               Multiplication : reel * reel = reel                 #
  4166. #                                                                   #
  4167. #       entree : a7@(4) pointe sur r2 de type R                     #
  4168. #                a7@(8) pointe sur r1 de type R                     #
  4169. #       sortie : d0 pointe sur r2 * r1 de type R (zone creee)       #
  4170. #                                                                   #
  4171. #       precision : L = inf ( L1 , L2 )                             #
  4172. #                                                                   #
  4173. #===================================================================#
  4174.  
  4175. _mulrr: link    a6,#-20          | variables locales pour murr aussi
  4176.         moveml  d2-d7/a2-a4,sp@-
  4177.         movl    a6@(8),a1       | a1 pointe sur r1
  4178.         movl    a6@(12),a2      | a2 pointe sur r2
  4179.         movb    a1@(4),d0
  4180.         andb    a2@(4),d0
  4181.         bne     munzr
  4182.                                 | ici r1 ou r2 = 0
  4183. muzr:   moveq   #3,d0
  4184.         bsr     getr
  4185.         movl    a0,a6@(-8)
  4186.         movl    a1@(4),d1       
  4187.         andl    #0xffffff,d1    | exposant de x1
  4188.         movl    a2@(4),d2       
  4189.         andl    #0xffffff,d2    | exposant de y
  4190.         addl    d2,d1
  4191.         subl    #0x800000,d1
  4192.         cmpl    #0x1000000,d1
  4193.         bcs     1$
  4194.         movl    #muler4,sp@-    | debordement r*r
  4195.         jsr     _err
  4196. 1$:     tstl    d1
  4197.         bgt     2$
  4198.         movl    #muler5,sp@-    | underflow r*r
  4199.         jsr     _err
  4200. 2$:     movl    d1,a0@(4)
  4201.         clrl    a0@(8)
  4202.         bra     mulrrf
  4203.  
  4204. munzr:  movw    a2@(2),d0
  4205.     clrl    a6@(-12)    | Initialiser flag a 0
  4206.         cmpw    a1@(2),d0
  4207.         bls     1$
  4208.         movw    a1@(2),d0       | d0.w contient L+2=inf(L1,L2)+2
  4209.         exg     a1,a2           | a2 pointe sur le + court
  4210.     bra    2$
  4211. 1$:    bne    2$
  4212.         lea     a1@(0,d0:w:4),a3 | a3 pointe sur x[L+1]
  4213.     movl    a3,a6@(-12)    | longueurs egales: flag egal adresse
  4214.     movl    a3@,a6@(-16)    | sauvegarde de x[L+1]
  4215.     clrl    a3@
  4216. 2$:     bsr     getr
  4217.         movl    a0,a6@(-8)
  4218.         bsr     murr            | effectuer la multiplication
  4219.     tstl    a6@(-12)
  4220.     beq    mulrrf
  4221.     movl    a6@(-12),a3
  4222.     movl    a6@(-16),a3@    | remettre x[L+1]
  4223. mulrrf: movl    a6@(-8),d0      | adresse du resultat
  4224.         moveml  sp@+,d2-d7/a2-a4
  4225.         unlk    a6
  4226.         rts
  4227.  
  4228. #-------------------------------------------------------------------#
  4229. #       module interne de multiplication r0=r1*r2                   #
  4230. #               ( pour R*R et I*R)                                  #
  4231. #       entree : a1 et a2 pointent sur 2 reels                      #
  4232. #       r1,r2  non nuls avec L1>=L2=m                               #
  4233. #                a0 pointe sur une zone reelle de long l1           #
  4234. #       sortie : le produit r0 est mis a l'addresse a0              #
  4235. #                                                                   #
  4236. #-------------------------------------------------------------------#
  4237.  
  4238. | notation : r1 = x = x1x2...xmx(m+1)...  multiplicande
  4239. |            r2 = y = y1y2...ym           multiplicateur
  4240. |       ( le lgmot x(m+1) peut ne pas exister ! ( le1 >= le2 = m ) )
  4241. |             z = z0z1z2...zmz(m+1) resultat.
  4242. |       ( z0=0 ou 1 et z(m+1) a jeter)
  4243.  
  4244. murr:   movl    a1,a3
  4245.         lea     a3@(12),a3      | a3 pointe sur x2 (2me lgmot mant.x)
  4246. #       movw    a2@(2),d0       | d0.w=L2=m long commune des mantisses (mis a l'appel!)
  4247.         lea     a2@(0,d0:w:4),a2| a2 pointe apres ym
  4248.         lea     a0@(0,d0:w:4),a0| a0 pointe apres zm
  4249.         movl    a0@,a6@(-4)     | on sauvegarde le lg mot suivant z
  4250.         clrl    a0@+            | z(m+1) recoit 0,a0 pointe apres z(m+1)
  4251.         subqw   #3,d0           | d0 recoit m-1 
  4252.         movl    d0,a6@(-20)     | sauvegarde m-1 compt. bcl externe
  4253.         clrw    d3              | d3=0,val initiale compt bcl interne
  4254.                                 | Boucles triangulaires mult. R*R
  4255. #...................................................................#
  4256. bext:   movl    a0,a4           | a4 pointe apres z(m+1)
  4257.         movl    a3,a1           | a1 pointe sur x(j+1) (j=1,2...m)
  4258.         movw    d3,d2           | d3 recoit m-j compt bcl interne
  4259.         movl    a2@-,d4         | d4 recoit yj
  4260.         movl    a3@+,d5         | d5 recoit x(j+1)
  4261.     subl    d1,d1        | d1 a zero ainsi que bit X
  4262.         mulul   d4,d7:d5        | init.retenue d7(ignorer poids faible)
  4263. bint:   movl    d7,d6        | sauvegarder nouvelle retenue
  4264.     movl    d4,d5        | dupliquer multiplicateur
  4265.         mulul   a1@-,d7:d5      | d7:d5 recoit xi*yj
  4266.         addxl   d5,d6
  4267.         addxl   d1,d7           | d7:d5 recoit xi*yj + k
  4268.         addl    d6,a4@-         | nouveau z(i+j)
  4269.         dbra    d2,bint
  4270.     addxl    d1,d7
  4271.         movl    d7,a4@-         | range derniere retenue
  4272.         addqw   #1,d3           | augmente de 1 long bcl interne
  4273.         dbra    d0,bext         | fin bcl externe
  4274. #...................................................................#
  4275.         movl    a1@(-4),d1      | a1 pointe sur x1 (1er mot mant de x)
  4276.         andl    #0xffffff,d1    | exposant de x1
  4277.         movl    a2@(-4),d2      | a2 pointe sur y1
  4278.         andl    #0xffffff,d2    | exposant de y
  4279.         addl    d2,d1
  4280.         subl    #0x800000,d1
  4281.         tstl    a4@             | a4 pointe sur z1 : z normalise ?
  4282.         bpl     1$
  4283.         addl    #1,d1           | ici mantisse normalisee
  4284.         bra     2$
  4285.                                 | ici il faut shifter de 1 a gauche
  4286. 1$:     movl    a0,a4           | a4 pointe apres z(m+1)
  4287.         subqw   #2,a4
  4288.     movl    a6@(-20),d0    | recuperer m-1
  4289.         roxlw   a4@-            | initialise le carry
  4290. 5$:     roxlw   a4@-            | shift par mots (d0 compteur=m-1)
  4291.         roxlw   a4@-
  4292.         dbra    d0,5$           | boucle de shift
  4293. 2$:     cmpl    #0x1000000,d1
  4294.         bcs     3$
  4295.         movl    #muler4,sp@-    | debordement r*r
  4296.         jsr     _err
  4297. 3$:     tstl    d1
  4298.         bgt     4$
  4299.         movl    #muler5,sp@-    | underflow r*r
  4300.         jsr     _err
  4301. 4$:     movl    d1,a4@-         | range exposant
  4302.         movb    a1@(-4),d1
  4303.         movb    a2@(-4),d2      | signes
  4304.         eorb    d2,d1
  4305.         addqb   #1,d1
  4306.         movb    d1,a4@          | range signe resultat
  4307.         movl    a6@(-4),a0@(-4) | remet en place mot sous z(m+1)
  4308. murrf:  rts
  4309.  
  4310. #===================================================================#
  4311. #                                                                   #
  4312. #               Multiplication : entier * reel = reel               #
  4313. #                                                                   #
  4314. #       entree : a7@(4) pointe sur i2 de type I                     #
  4315. #                a7@(8) pointe sur r1 de type R                     #
  4316. #       sortie : d0 pointeur sur i2 * r1 de type R (zone creee)     #
  4317. #                                                                   #
  4318. #===================================================================#
  4319.  
  4320. _mulir: link    a6,#-20
  4321.         moveml  d2-d7/a2-a4,sp@-
  4322.         movl    a6@(8),a2       | a2 pointe sur i2
  4323.         tstb    a2@(4)
  4324.         bne     1$
  4325.                                 | ici i2 = 0
  4326.     movl    _gzero,d0
  4327.         bra     mulirf1
  4328.                                 | ici i2 <> 0
  4329. 1$:     movl    a6@(12),a1      | a1 pointe sur r1
  4330.         tstb    a1@(4)
  4331.         bne     2$
  4332.                                 | ici r1 = 0
  4333.         moveq   #3,d0
  4334.         bsr     getr
  4335.         movw    a2@(6),d0
  4336.         lsll    #5,d0
  4337.         bfffo   a2@(8){#0:#0},d1
  4338.         subl    d1,d0
  4339.         subl    #65,d0
  4340.         addl    a1@(4),d0
  4341.         cmpl    #0x1000000,d0
  4342.         bcs     3$
  4343.         movl    #muler6,sp@-    | overflow I*R, R = 0
  4344.         jsr     _err
  4345. 3$:     movl    d0,a0@(4)
  4346.         clrl    a0@(8)
  4347.         movl    a0,d0
  4348.         bra     mulirf1
  4349.                                 | ici i2 <> 0 et r1<> 0
  4350. 2$:     movw    a1@(2),d0
  4351.         bsr     getr            | allocation memoire pour resultat
  4352.         movl    a0,a6@(-8)      | sauvegarde adresse resultat
  4353.     addqw    #1,d0
  4354.         bsr     getr            | allocation mem pour conversion i2->r2
  4355.         movl    a0,a7@-
  4356.         movl    a2,a7@-
  4357.         bsr     _affir
  4358.         addql   #4,sp
  4359.         movl    a7@,a2          | a2 recoit adr de r2=i2 (reste en pile)
  4360.         movl    a6@(-8),a0      | a0 recoit addresse du resultat
  4361.     exg    a1,a2        | Il faut que a2 soit le plus court!
  4362.     movw    a2@(2),d0    | Mettre la plus petite longueur dans d0 pour murr
  4363.         bsr     murr
  4364.         movl    a7@+,a0
  4365.         bsr     giv
  4366. mulirf: movl    a6@(-8),d0
  4367. mulirf1:moveml  sp@+,d2-d7/a2-a4
  4368.         unlk    a6
  4369.         rts
  4370.  
  4371.  
  4372.  
  4373.  
  4374.  
  4375. #*******************************************************************#
  4376. #*******************************************************************#
  4377. #**                                                               **#
  4378. #**             PROGRAMMES DE DIVISION AVEC RESTE                 **#
  4379. #**                                                               **#
  4380. #*******************************************************************#
  4381. #*******************************************************************#
  4382.  
  4383.  
  4384.  
  4385.  
  4386.  
  4387. #===================================================================#
  4388. #                                                                   #
  4389. #               Division avec reste (par valeur)                    #
  4390. #                                                                   #
  4391. #       entree : a7@(4) pointe sur n2 de type I                     #
  4392. #                a7@(8) pointe sur n1 de type I                     #
  4393. #                a7@(12) pointe sur n3 de type I                    #
  4394. #                a7@(16) pointe sur n4 de type I                    #
  4395. #       sortie : la zone pointee par a7@(12) contient n2 / n1       #
  4396. #                la zone pointee par a7@(16) contient le reste (du  #
  4397. #                signe du dividende)                                #
  4398. #       interdit : type S et R                                      #
  4399. #                                                                   #
  4400. #===================================================================#
  4401.  
  4402. _mpdvmdz:lea    _dvmdii,a0
  4403.         bra     mpopii
  4404.  
  4405.                                 | division avec reste S/S=(I et I)
  4406.                                 | sinon erreur
  4407.  
  4408. _dvmdssz:lea    _dvmdss,a0
  4409.         bra     mpopii
  4410.  
  4411.                                 | division avec reste S/I=(I et I)
  4412.                                 | sinon erreur
  4413.  
  4414. _dvmdsiz:lea    _dvmdsi,a0
  4415.         bra     mpopii
  4416.  
  4417.                                 | division avec reste I/S=(I et I)
  4418.                                 | sinon erreur
  4419.  
  4420. _dvmdisz:lea    _dvmdis,a0
  4421.         bra     mpopii
  4422.  
  4423.                                 | division avec reste I/I=(I et I)
  4424.                                 | sinon erreur
  4425.  
  4426. _dvmdiiz:lea    _dvmdii,a0
  4427.         bra     mpopii
  4428.  
  4429. #===================================================================#
  4430. #                                                                   #
  4431. #Division avec reste : entier court / entier court =(entier,entier) #
  4432. #                                                                   #
  4433. #       entree : a7@(4) contient s2 de type S                       #
  4434. #                a7@(8) contient s1 de type S                       #
  4435. #       sortie : a7@(12) pointe sur l'adresse du futur reste        #
  4436. #                d0 pointe sur s2 div s1 de type I                  #
  4437. #                le reste est du signe de s2 (zone creee)           #
  4438. #                                                                   #
  4439. #===================================================================#
  4440.  
  4441. _dvmdss:link    a6,#0
  4442.         movl    d2,sp@-
  4443.         movl    a6@(12),sp@-    | empilage s1
  4444.         movl    a6@(8),sp@-     | empilage s2
  4445.         bsr     _divss
  4446. dmd:    addql   #8,sp
  4447.         tstl    d1
  4448.         bne     1$
  4449.                                 | ici reste nul
  4450.     movl    _gzero,a0
  4451.         bra     dvmdssf
  4452.                                 | ici reste non nul
  4453. 1$:     movl    d0,d2
  4454.         moveq   #3,d0
  4455.         bsr     geti
  4456.         movl    #0x1000003,a0@(4)
  4457.         tstl    d1
  4458.         bpl     2$
  4459.         negl    d1
  4460.         movb    #-1,a0@(4)
  4461. 2$:     movl    d1,a0@(8)
  4462.         movl    d2,d0
  4463. dvmdssf:movl    a6@(16),a1
  4464.         movl    a0,a1@
  4465.         movl    sp@,d2
  4466.         unlk    a6
  4467.         rts
  4468.  
  4469. #===================================================================#
  4470. #                                                                   #
  4471. #   Division avec reste : entier court / entier = (entier,entier)   #
  4472. #                                                                   #
  4473. #       entree : a7@(4) contient s2 de type S                       #
  4474. #                a7@(8) pointe sur i1 de type I                     #
  4475. #                a7@(12) pointe sur l'adresse du futur reste        #
  4476. #       sortie : d0 pointe sur s2 div i1 de type I ;                #
  4477. #                reste du signe de s2 (zones creees)                #
  4478. #                                                                   #
  4479. #===================================================================#
  4480.  
  4481. _dvmdsi:movl    a7@(8),sp@-
  4482.         movl    a7@(8),sp@-
  4483.         bsr     _divsi
  4484. dmdi:   addql   #8,sp
  4485.         tstl    d1
  4486.         bne     1$
  4487.                                 | ici reste nul
  4488.     movl    _gzero,sp@(12)@
  4489.     rts
  4490.                                 | ici reste non nul
  4491. 1$:     movl    d0,a1           | sauvegarde adresse quotient
  4492.         moveq   #3,d0
  4493.         bsr     geti
  4494.         movl    #0x1000003,a0@(4)
  4495.         tstl    d1
  4496.         bpl     2$
  4497.         negl    d1
  4498.         movb    #-1,a0@(4)
  4499. 2$:     movl    d1,a0@(8)
  4500. 3$:     movl    a1,d0
  4501.         movl    a0,sp@(12)@
  4502.         rts
  4503.  
  4504. #===================================================================#
  4505. #                                                                   #
  4506. #   Division avec reste : entier / entier court = (entier,entier)   #
  4507. #                                                                   #
  4508. #       entree : a7@(4) pointe sur i2 de type I                     #
  4509. #                a7@(8) contient s1 de type S                       #
  4510. #                a7@(12) pointe sur l'adresse du futur reste        #
  4511. #       sortie : d0 pointe sur i2 div s1 de type I                  #
  4512. #                reste de type I du signe de s1 (zones creees)      #
  4513. #                                                                   #
  4514. #===================================================================#
  4515.  
  4516. _dvmdis:movl    a7@(8),sp@-
  4517.         movl    a7@(8),sp@-
  4518.         bsr     _divis
  4519.         bra     dmdi
  4520.  
  4521. #===================================================================#
  4522. #                                                                   #
  4523. #       Division avec reste : entier / entier = (entier,entier)     #
  4524. #                                                                   #
  4525. #       entree : a7@(4) pointe sur i2 de type I (dividende)         #
  4526. #                a7@(8) pointe sur i1 de type I (diviseur)          #
  4527. #                a7@(12) contient un pointeur sur le reste si l'on  #
  4528. #                veut a la fois q et r, 0 si l'on ne veut que le    #
  4529. #                quotient, -1 si l'on ne veut que le reste          #
  4530. #       sortie : d0 pointe sur q si celui-ci est attendu, et sinon  #
  4531. #                sur r. a7@(12) pointe sur r si q et r sont attendus#
  4532. #                (toutes les zones sont creees)                     #
  4533. #       remarque : il s'agit de la 'fausse division' ; le reste est #
  4534. #                 du signe du dividende                             #
  4535. #                                                                   #
  4536. #                                                                   #
  4537. #       variables locales (etat pile apres link):                   #
  4538. #  -16 -14 -12 -10 -8  -6   -4    a6    4    8    12   16           #
  4539. #  +---+---+---+---+---+---+------+----+----+----+----+----+        #
  4540. #   n-m  k sgnq sgnr n   m  ad(q,r)      ret  i2   i1 ^r/0/-1       #
  4541. #                                                                   #
  4542. #===================================================================#
  4543.  
  4544. _dvmdii:link    a6,#-32
  4545.         moveml  d2-d7/a2-a4,sp@-
  4546.         movl    a6@(12),a1      | a1 pointe sur le diviseur i1
  4547.         movw    a1@(6),d1       | d1.w contient le1
  4548.         cmpw    #2,d1
  4549.         bne     dv1
  4550.                                 | ici i1 = 0
  4551.         movl    #dvmer1,sp@-
  4552. dvmerr: jsr     _err
  4553.                                 | ici i1 <> 0
  4554. dv1:    movl    a6@(8),a2       | a2 pointe sur dividende i2
  4555.         movw    a2@(6),d2       | d2.w contient le2
  4556.         cmpw    #2,d2
  4557.         bne     dv3
  4558.                                 | ici quotient=reste=0
  4559. dv2:    movl    a6@(16),d3
  4560.         cmpl    #-1,d3
  4561.         beq     1$
  4562.                                 | ici quotient attendu (q=0)
  4563.     movl    _gzero,d0
  4564. 1$:     tstl    d3
  4565.         beq     dvmiif
  4566.                                 | ici reste attendu (r=0)
  4567.     movl    _gzero,a0
  4568.         btst    #0,d3           | test si fonction mod
  4569.         bne     2$
  4570.         movl    d3,a1           | d3 pointe sur l'adr. du reste
  4571.         movl    a0,a1@
  4572.         bra     dvmiif
  4573. 2$:     movl    a0,d0
  4574.         bra     dvmiif
  4575.                                 | ici i2 et i1 <> 0
  4576. dv3:    movw    d2,d0           | le2
  4577.         subw    d1,d0           | d0.w contient L2-L1
  4578.         bcc     dv4
  4579.                                 | ici q=0 , r=i2
  4580.         movl    a6@(16),d3
  4581.         cmpl    #-1,d3
  4582.         beq     1$
  4583.                                 | quotient attendu soit q=0
  4584.     movl    _gzero,d0
  4585. 1$:     tstl    d3
  4586.         beq     dvmiif
  4587.                                 | reste attendu soit r=i1
  4588.         movl    d0,d1
  4589.         movw    d2,d0
  4590.         bsr     geti
  4591.         movl    a0,a1
  4592.         subqw   #2,d0
  4593.         addql   #4,a0
  4594.         addql   #4,a2
  4595. 2$:     movl    a2@+,a0@+
  4596.         dbra    d0,2$
  4597.         cmpl    #-1,d3
  4598.         beq     3$
  4599.         movl    d3,a0
  4600.         movl    a1,a0@
  4601.         movl    d1,d0
  4602.         bra     dvmiif
  4603. 3$:     movl    a1,d0
  4604.         bra     dvmiif
  4605.                                 | ici L2 >= L1
  4606. dv4:    movb    a1@(4),d3       | d3.b contient signe de i1
  4607.         movb    a2@(4),d4       | d4.b contient signe de i2
  4608.         eorb    d4,d3
  4609.         addqb   #1,d3           | d4.b contient signe de q
  4610.         movb    d3,a6@(-12)     | sauvegarde signe de q
  4611.         movb    d4,a6@(-10)     | sauvegarde signe de r
  4612.         movl    _avma,a6@(-20)  | sauvegarde _avma initial
  4613.         movw    d2,d0           | d0 recoit l2
  4614.         bsr     geti            | allocation memoire de travail :
  4615.                                 | on va y former q0q1...q(n-m)r1r2...rm
  4616.                                 | les memoires provisoires ne seront pas
  4617.                                 | rendues par giv:on ecrase mot code
  4618.         movl    a0,a6@(-4)      | sauvegarde addresse zone de travail
  4619.         subqw   #2,d1
  4620.         subqw   #2,d2
  4621.         movw    d1,a6@(-6)      | sauvegarde L1 (=m)
  4622.         movw    d2,a6@(-8)      | sauvegarde L2 (=n)
  4623.         movw    d2,a6@(-16)
  4624.         subw    d1,a6@(-16)     | n-m dans a6@(-16)
  4625.         addql   #8,a2
  4626.         addql   #8,a1
  4627.         movl    a1@,d3          | d3.l=y1 (1er lgmot du diviseur i1)
  4628.         subqw   #1,d2           | d2 recoit n-1
  4629.         subqw   #1,d1           | d1 recoit m-1
  4630.         bne     divlon
  4631.                                 | ici division simple (m = 1)
  4632. divsim: clrl    d4
  4633. 1$:     movl    a2@+,d5
  4634.         divul   d3,d4:d5
  4635.         movl    d5,a0@+
  4636.         dbra    d2,1$
  4637.         movl    d4,a0@          | reste mis derriere quotient
  4638.         movl    a0,a2           | a2 pointe sur reste
  4639.         clrw    a6@(-14)        | on n'a pas fait de shift
  4640.         bra     ranger
  4641.                                 | ici division longue (m > 1)
  4642. divlon: bfffo   d3{#0:#0},d4    | d4 recoit nb de shift pour normaliser
  4643.         movw    d4,a6@(-14)     | sauvegarde du nb. de shifts = k
  4644.         bne     1$
  4645.                                 | ici pas de normalisation
  4646.         movl    a0,a4
  4647.         movl    #0,a4@+         | met a 0 1er lgmot soit x0
  4648. 4$:     movl    a2@+,a4@+       | recopie x1x2...xn
  4649.         dbra    d2,4$
  4650.         movl    a0,a2           | a2 pointe sur x0,a4 pointe apres xn
  4651.         lea     a1@(4,d1:w:4),a3| a1 pointe sur y1,a3 pointe apres ym
  4652.         bra     nosh
  4653.                                 | ici on normalise le diviseur i1=y
  4654.                                 | et on decale autant le dividende:
  4655. 1$:     lsll    d4,d3           | normalisation de y1
  4656.         movw    a6@(-6),d0      | on demande m lgmots
  4657.         bsr     geti            | allocation pour copie normalisee de y
  4658.         moveq   #1,d6
  4659.         lsll    d4,d6
  4660.         subql   #1,d6           | masque de shift
  4661.         movl    a0,a3
  4662.         subqw   #1,d0           | d0 compt. mis a m-1
  4663.         addql   #4,a1           | a1 pointe sur y2 2me lg mot diviseur
  4664.         bra     3$
  4665. 2$:     movl    a1@+,d1         | boucle shift vers la gauche ds copie
  4666.         roll    d4,d1
  4667.         movl    d1,d5
  4668.         andl    d6,d1
  4669.         addl    d1,d3
  4670.         movl    d3,a3@+
  4671.         subl    d1,d5
  4672.         movl    d5,d3
  4673. 3$:     dbra    d0,2$
  4674.         movl    d3,a3@+
  4675.         movl    a0,a1           | a1 pointe sur 1er lgmot y1 normalise
  4676.                                 | a3 pointe apres ym
  4677.                                 | transfert avec shift du dividende:
  4678.         movl    a6@(-4),a4      | a4 pointe sur zone de travail
  4679.         moveq   #0,d3
  4680.         movw    a6@(-8),d0
  4681.         subqw   #1,d0           | d0 recoit n-1 compteur
  4682. 5$:     movl    a2@+,d1         | boucle de shift du dividende i2
  4683.         roll    d4,d1           | sur place
  4684.         movl    d1,d5           
  4685.         andl    d6,d1
  4686.         addl    d1,d3
  4687.         movl    d3,a4@+
  4688.         subl    d1,d5
  4689.         movl    d5,d3
  4690.         dbra    d0,5$
  4691.         movl    d3,a4@
  4692.         movl    a6@(-4),a2      | a2 pointe sur x0 ;(a4 pointe sur xn)
  4693. nosh:   movw    a6@(-6),d6      | d6 recoit m
  4694.         lea     a2@(4,d6:w:4),a4| a4 pointe apres xm
  4695.         subqw   #1,d6           | d6 recoit m-1 compteur bcls internes
  4696.         movw    a6@(-16),d7     | d7 recoit n-m compteur bcl externe
  4697. #-------------------------------------------------------------------#
  4698.                                 | boucles de division I / I :
  4699.         | a1 pointe sur y1, a3 pointe apres ym : diviseur y1y2...ym
  4700.         | a2 pointe sur x0, a4 pointe apres xm : dividende x0x1...xn
  4701.         | d7 contient n-m compt. boucle externe
  4702.         | d6 contient m compt. boucles internes (n>=m>=2)
  4703.         | la zone x0x1...xn recoit q0q1...q(n-m)r1r2...rm
  4704.  
  4705. bclext: movl    a1@,d0          | d0 recoit y1 (1er lgmot diviseur)
  4706.         cmpl    a2@,d0          | xi = y1 ? (i=0,1...n)
  4707.         bne     1$
  4708.         moveq   #-1,d1          | oui: essayer q=2^32-1
  4709.         addl    a2@(4),d0       | calcul du reste
  4710.                                 | r=xix(i+1) mod y1 = xi+x(i+1)
  4711.         bcs     4$              | si r>=2^32 , q est ok
  4712.         movl    d0,d2           | sinon d2 recoit r
  4713.         bra 2$                  | rejoindre cas general
  4714. 1$:     movl    a2@,d2          | si xi<y1 :
  4715.         movl    a2@(4),d1       | d2:d1 recoit xix(i+1)
  4716.         divul   d0,d2:d1        | d1 recoit q = xix(i+1) div y1
  4717.                                 | d2 recoit r = xix(i+1) mod y1
  4718. 2$:     movl    a1@(4),d3       | d3 recoit y2
  4719.         mulul   d1,d4:d3        | d4:d3 recoit q*y2
  4720.         subl    a2@(8),d3
  4721.         subxl   d2,d4           | d4:d3 recoit q*y2-(r,x(i+2))
  4722.         bls     4$              | si <= 0 alors q ok
  4723. 3$:     subql   #1,d1           | sinon diminuer q
  4724.         subl    a1@(4),d3       | corriger reste partiel:
  4725.         subxl   d0,d4           | d3:d4 recoit d3:d4-y1y2
  4726.         bhi     3$              | tant que q*y1y2>xix(i+1)x(i+2)
  4727.                                 | recommencer q recoit q-1
  4728.                                 | ici q*y1y2 <= xix(i+1)x(i+2)
  4729.                                 | on va former le nouveau reste
  4730.                                 | en remplacant x(i+1)...x(i+m) par
  4731.                                 | x(i+1)...x(i+m) - q*y1...ym
  4732. 4$:     movw    d6,d0           | d0 recoit m-1 compteur
  4733.         movl    a3,a1           | a1 pointe apres ym
  4734.         movl    a4,a2           | a2 pointe apres x(i+m)
  4735.         moveq   #0,d2           | d2 fixe a 0 pour les addxl
  4736.         subl    d3,d3           | d3 recoit k retenue initialisee a 0 et X=0
  4737. 5$:     movl    a1@-,d5         | d5 recoit x(i+j) j=m,m-1,...,1
  4738.         mulul   d1,d4:d5
  4739.         addxl   d3,d5
  4740.         addxl   d2,d4
  4741.         subl    d5,a2@-         | nouvel x(i+j)
  4742.         movl    d4,d3
  4743.         dbra    d0,5$
  4744.     addxl    d2,d3
  4745.         subl    d3,a2@(-4)      | soustrait derniere retenue
  4746.         bcc     6$              | si pas carry q=qi est definitif
  4747.         subql   #1,d1           | sinon encore 1 de trop
  4748.         movw    d6,d0           | repositionner compteur m-1
  4749.         movl    a3,a1
  4750.         movl    a4,a2           | repositionner pointeurs
  4751. 7$:     addxl   a1@-,a2@-
  4752.         dbra    d0,7$           | boucle de remise a jour du reste
  4753.                                 | il y a forcement carry final a ignorer
  4754. 6$:     movl    d1,a2@(-4)      | qi est range sur l'ancien xi
  4755.         addql   #4,a4           | a4 pointe apres x(i+m+1)
  4756.         dbra    d7,bclext       | boucler pour q0q1...q(n-m)
  4757.                                 | fin des boucles de division I/I
  4758.                                 | a2 pointe apres q(n-m),ie sur r1
  4759. #-------------------------------------------------------------------#
  4760.                                 | rangement des resultats
  4761.  
  4762. ranger: clrl    a6@(-28)
  4763.         clrl    a6@(-32)
  4764.         movl    _avma,a6@(-24)  | actuel _avma
  4765.         movl    a6@(-20),d7     | _avma initial
  4766.         subl    _avma,d7        | nb d'octets memoire provisoires
  4767.                                 | offset:ajouter aux addresses fournies
  4768.         movl    a6@(16),d3
  4769.         cmpl    #-1,d3
  4770.         beq     rngres
  4771.                                 | ici quotient attendu
  4772.         movl    a6@(-4),a0      | a0 pointe sur q0
  4773.         movw    a6@(-16),d0     | d0 recoit n-m
  4774.         movw    d0,d1
  4775.         addqw   #2,d0
  4776.         tstl    a0@
  4777.         beq     1$
  4778.         addqw   #1,d0
  4779. 1$:     bsr     geti            | allocation memoire pour quotient
  4780.         movl    a0,a6@(-28)     | a6@(-28) recoit adr. provisoire de q
  4781.         addl    d7,a6@(-28)     | ajoute offset memoires provisoires
  4782.                                 | a6@(-28) contient adr definitive de q
  4783.         lea     a0@(0,d0:w:4),a1
  4784.         movl    a2,a3           | a2 et a3 pointe sur r1
  4785. 2$:     movl    a3@-,a1@-       | recopie q0,q1...q(n-m)
  4786.         dbra    d1,2$
  4787.         movw    d0,a0@(6)       | met long effective de q
  4788.         movb    a6@(-12),a0@(4) | met signe de q
  4789.         cmpw    #2,d0
  4790.         bne     rngres
  4791.         clrb    a0@(4)          | rectifier signe lorsque q=0
  4792. rngres: tstl    d3
  4793.         beq     rendre
  4794.                                 | ici reste attendu
  4795.         movw    a6@(-6),d0
  4796.         subqw   #1,d0           | d0 recoit m-1
  4797. 4$:     tstl    a2@+
  4798.         dbne    d0,4$           | chasse les zeros
  4799.         bne     1$
  4800.                                 | ici r=0 : ranger 0
  4801.         movw    #2,d0
  4802.         bsr     geti
  4803.         movl    #2,a0@(4)
  4804.         addl    d7,a0           | ajoute offset
  4805.         movl    a0,a6@(-32)     | adr. definit. de r
  4806.         bra     rendre
  4807. 1$:     subql   #4,a2           | a2 pointe sur 1er ri non nul
  4808.         movw    d0,d1
  4809.         addqw   #3,d0
  4810.         bsr     geti            | allocation memoire pour reste
  4811.         movl    a0,a6@(-32)
  4812.         addl    d7,a6@(-32)     | ajoute offset memoires provisoires
  4813.         movb    a6@(-10),a0@(4) | met signe de r
  4814.         movw    d0,a0@(6)       | met long effect provisoire (si shift)
  4815.         addql   #8,a0
  4816.         movw    a6@(-14),d3     | d3 recoit k nb de shifts
  4817.         bne     2$
  4818.                                 | ici k=0 pas de shift
  4819. 5$:     movl    a2@+,a0@+
  4820.         dbra    d1,5$           | recopie des ri effectifs
  4821.         bra     rendre
  4822. 2$:     moveq   #-1,d6          | ici shift de r
  4823.         lsrl    d3,d6           | d6 recoit masque de shift
  4824.         moveq   #0,d5
  4825.         bset    d3,d5           | d5 recoit 2^k
  4826.         moveq   #0,d2
  4827.         cmpl    a2@,d5          | comparer 1er ri a 2^k
  4828.         bls     3$
  4829.         movl    a2@+,d2         | ici ri < 2^k  : le shifter
  4830.         rorl    d3,d2
  4831.         subqw   #1,d0           | et diminuer de 1 la long de la boucle
  4832.         subqw   #1,a0@(-2)      | ainsi que la long effective de r
  4833. 3$:     movl    a2@+,d5         | boucle de shift de r
  4834.         rorl    d3,d5           | boucle jamais vide car r>=2^k
  4835.         movl    d5,d4
  4836.         andl    d6,d4
  4837.         addl    d4,d2
  4838.         movl    d2,a0@+
  4839.         subl    d4,d5
  4840.         movl    d5,d2
  4841.         dbra    d1,3$
  4842. rendre: movl    a6@(-20),a0     | rendre memoires provisoires
  4843.         movl    a6@(-24),a1     | il faut rendre la zone entre a1 et a0
  4844.         movl    a1,d0
  4845.         subl    _avma,d0
  4846.         lsrl    #2,d0           | nb de lgmots a deplacer
  4847.         subqw   #1,d0
  4848. 1$:     movl    a1@-,a0@-
  4849.         dbra    d0,1$
  4850.         movl    a0,_avma        | nouvel _avma
  4851.         movl    a6@(-28),d0
  4852.         bne     2$
  4853.         movl    a6@(-32),d0
  4854.         bra     dvmiif
  4855. 2$:     tstl    a6@(-32)
  4856.         beq     dvmiif
  4857.         movl    a6@(16),a1
  4858.         movl    a6@(-32),a1@
  4859. dvmiif: moveml  sp@+,d2-d7/a2-a4
  4860.         unlk    a6
  4861.         rts
  4862.  
  4863.  
  4864.  
  4865. #===================================================================#
  4866. #                                                                   #
  4867. #                       Divisibilite de i2 par i1                   #
  4868. #                                                                   #
  4869. #       entree : a7@(4) pointe sur n2 de type I                     #
  4870. #                a7@(8) pointe sur n1 de type I                     #
  4871. #                a7@(12) contient un pointeur ( pour quotient )     #
  4872. #       sortie : d0 contient 1 si n1 divise n2                      #
  4873. #                            0 sinon
  4874. #       a7@(12) pointe sur n2 / n1 de type I  (zone creee)          #
  4875. #       lorsque n1 divise n2,  sinon n'est pas affecte.             #
  4876. #                                                                   #
  4877. #===================================================================#
  4878.  
  4879. _mpdivis:link a6,#-8
  4880.         movl    _avma,a6@(-8)
  4881.         pea     a6@(-4)
  4882.         movl    a6@(12),sp@-
  4883.         movl    a6@(8),sp@-
  4884.         bsr     _dvmdii
  4885.         lea     sp@(12),sp
  4886.         tstb    a6@(-4)@(4)             | reste nul ?
  4887.         beq     1$
  4888.                                         | ici reste non nul
  4889.         moveq   #0,d0
  4890.         movl    a6@(-8),_avma           | desallouer q et r
  4891.         bra     2$
  4892.                                         | ici reste nul
  4893. 1$:     movl    a6@(16),sp@-
  4894.         movl    d0,sp@-                 | adresse du quotient
  4895.         bsr     _affii
  4896.         moveq   #1,d0
  4897.         movl    a6@(-8),_avma                   | desallouer reste
  4898. 2$:     unlk    a6
  4899.         rts
  4900.  
  4901.  
  4902. #===================================================================#
  4903. #                                                                   #
  4904. #               Flag de divisibilite de i2 par i1                   #
  4905. #                                                                   #
  4906. #       entree : a7@(4) pointe sur n2 de type I                     #
  4907. #                a7@(8) pointe sur n1 de type I                     #
  4908. #       sortie : d0 contient 1 si n1 divise n2                      #
  4909. #                            0 sinon                                #
  4910. #                                                                   #
  4911. #===================================================================#
  4912.  
  4913. _divise: movl   #-1,sp@-
  4914.         movl    sp@(12),sp@-
  4915.         movl    sp@(12),sp@-
  4916.         bsr     _dvmdii
  4917.         lea     sp@(12),sp
  4918.         movl    d0,a0
  4919.         moveq   #1,d0
  4920.         tstb    a0@(4)                  | reste nul ?
  4921.         beq     giv
  4922.                                         | ici reste non nul
  4923.         moveq   #0,d0
  4924.         bra     giv
  4925.  
  4926.  
  4927.  
  4928.  
  4929. #*******************************************************************#
  4930. #*******************************************************************#
  4931. #**                                                               **#
  4932. #**                     PROGRAMMES DE DIVISION                    **#
  4933. #**                                                               **#
  4934. #*******************************************************************#
  4935. #*******************************************************************#
  4936.  
  4937.  
  4938.  
  4939.  
  4940.  
  4941. #===================================================================#
  4942. #                                                                   #
  4943. #                       Division generale                           #
  4944. #                                                                   #
  4945. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  4946. #                a7@(8) pointe sur n1 de type I ou R                #
  4947. #       sortie : d0 pointe sur n2 / n1 de type I ou R (zone creee)  #
  4948. #                Le reste est du signe du dividende                 #
  4949. #       interdit : type S                                           #
  4950. #       precision : voir routines specialisees                      #
  4951. #                                                                   #
  4952. #===================================================================#
  4953.  
  4954. _mpdiv: cmpb    #1,sp@(8)@
  4955.         bne     1$
  4956.         cmpb    #1,sp@(4)@
  4957.         beq     _divii
  4958.         bra     _divri
  4959. 1$:     cmpb    #1,sp@(4)@
  4960.         beq     _divir
  4961.         bra     _divrr
  4962.  
  4963. #===================================================================#
  4964. #                                                                   #
  4965. #                       Division (par valeur)                       #
  4966. #                                                                   #
  4967. #       entree : a7@(4) pointe sur n2 de type I ou R                #
  4968. #                a7@(8) pointe sur n1 de type I ou R                #
  4969. #                a7@(12) pointe sur n3 de type I ou R               #
  4970. #       sortie : la zone pointee par a7@(12) contient n2 / n1 de    #
  4971. #                type le type de n3                                 #
  4972. #       interdit : type S ainsi que les divisions suivantes :       #
  4973. #                R/I=I , I/R=I ,R/R=I                               #
  4974. #                                                                   #
  4975. #===================================================================#
  4976.  
  4977. _mpdivz:movl    a2,sp@-
  4978.         movl    _avma,sp@-
  4979.         movl    sp@(12),a1
  4980.         movl    sp@(16),a0
  4981.         movl    sp@(20),a2      | a0,a1,a2 pointent sur n1,n2,n3
  4982.         cmpb    #1,a2@
  4983.         bne     1$
  4984.                                 | ici T3 = I
  4985.         cmpb    #1,a1@
  4986.         beq     2$
  4987.                                 | ici T3 = I et (T2 = R ou T1 = R)
  4988. 3$:     movl    #divzer1,sp@-
  4989.         jsr     _err
  4990.                                 | ici T3 = I et T2 = I
  4991. 2$:     cmpb    #1,a0@
  4992.         bne     3$
  4993.                                 | ici T3 = T2 = T1 = I
  4994.         movl    a0,sp@-
  4995.         movl    a1,sp@-
  4996.         bsr     _divii
  4997.         movl    a2,sp@(4)
  4998.         movl    d0,sp@
  4999.         bsr     _affii
  5000.         addql   #8,sp
  5001.         bra     divzf
  5002.                                 | ici T3 = R
  5003. 1$:     movl    a0,sp@-
  5004.         cmpb    #1,a0@
  5005.         beq     4$
  5006.                                 | ici T3 = R et T1 = R
  5007.         movl    a1,sp@-
  5008.         cmpb    #1,a1@
  5009.         beq     5$
  5010.                                 | ici T3 =T2 = T1 = R
  5011.         bsr     _divrr
  5012.         bra     6$
  5013.                                 | ici T3 = T1 = R et T2 = I
  5014. 5$:     bsr     _divir
  5015.         bra     6$
  5016.                                 | ici T3 = R et T1 = I
  5017. 4$:     cmpb    #1,a1@
  5018.         beq     7$
  5019.                                 | ici T3 = T2 = R et T1 = I
  5020.         movl    a1,sp@-
  5021.         bsr     _divri
  5022.         bra     6$
  5023.                                 | ici T3 = R et T2 = T1 = I
  5024. 7$:     movw    a2@(2),d0
  5025.         addqw   #1,d0
  5026.         bsr     getr
  5027.         movl    a0,sp@-
  5028.         movl    a1,sp@-
  5029.         bsr     _affir
  5030.     addql    #4,sp
  5031.         bsr     _divri
  5032. 6$:     movl    a2,sp@(4)
  5033.         movl    d0,sp@
  5034.         bsr     _affrr
  5035.         addql   #8,sp
  5036. divzf:  movl    sp@+,_avma
  5037.         movl    sp@+,a2
  5038.         rts
  5039.  
  5040.                                 | division S/R=R sinon erreur
  5041.  
  5042. _divsrz:lea     _divsr,a0
  5043.         bra     mpopz
  5044.  
  5045.                                 | division R/S=R sinon erreur
  5046.  
  5047. _divrsz:lea     _divrs,a0
  5048.         bra     mpopz
  5049.  
  5050.                                 | division I/R=R sinon erreur
  5051.  
  5052. _divirz:lea     _divir,a0
  5053.         bra     mpopz
  5054.  
  5055.                                 | division R/I=R sinon erreur
  5056.  
  5057. _divriz:lea     _divri,a0
  5058.         bra     mpopz
  5059.  
  5060.                                 | division R/R=R sinon erreur
  5061.  
  5062. _divrrz:lea     _divrr,a0
  5063.         bra     mpopz
  5064. #===================================================================#
  5065. #                                                                   #
  5066. #       Division par valeur : entier / entier = entier ou reel      #
  5067. #                                                                   #
  5068. #       entree : a7@(4) contient i2 de type S                       #
  5069. #                a7@(8) contient i1 de type S                       #
  5070. #                a7@(12) pointe sur i3 ou r3 de type I ou R         #
  5071. #       sortie : a7@(12) pointe sur i2 / i1 de type I ou R          #
  5072. #                                                                   #
  5073. #===================================================================#
  5074.  
  5075. _divssz:cmpb    #1,sp@(12)@
  5076.         bne     divssr
  5077. divssi: movl    sp@(8),sp@-
  5078.         movl    sp@(8),sp@-
  5079.         bsr     _divss
  5080.         movl    sp@(20),sp@(4)
  5081.         movl    d0,sp@
  5082.         bsr     _affii
  5083.         movl    sp@,a0
  5084.         addql   #8,sp
  5085.         bra     giv
  5086. divssr: movl    _avma,sp@-
  5087.         movw    sp@(16)@(2),d0
  5088.         bsr     getr
  5089.         movl    a0,sp@-
  5090.         movl    sp@(12),sp@-
  5091.         bsr     _affsr          | conversion dividende en R
  5092.         movl    sp@(4),sp@      | dividende converti
  5093.         movl    sp@(20),sp@(4)  | diviseur (type S)
  5094.         bsr     _divrs
  5095.         movl    sp@(24),sp@(4)
  5096.         movl    d0,sp@
  5097.         bsr     _affrr
  5098.         addql   #8,sp
  5099.         movl    sp@+,_avma
  5100.         rts
  5101.  
  5102. #===================================================================#
  5103. #                                                                   #
  5104. #       Division par valeur : S / I = entier ou reel                #
  5105. #                                                                   #
  5106. #       entree : a7@(4) contien i2 de type S                        #
  5107. #                a7@(8) pointe sur i1 de type I                     #
  5108. #                a7@(12) pointe sur i3 ou r3 de type I ou R         #
  5109. #       sortie : a7@(12) pointe sur i2 / i1 de type I ou R          #
  5110. #                                                                   #
  5111. #===================================================================#
  5112.  
  5113. _divsiz:link    a6,#0
  5114.         moveml  a2-a4,sp@-
  5115.         movl    a6@(16),a3
  5116.         cmpb    #1,a3@
  5117.         bne     divsir
  5118. divsii: movl    a6@(12),sp@-
  5119.         movl    a6@(8),sp@-
  5120.         bsr     _divsi
  5121.         movl    a6@(16),sp@(4)
  5122.         movl    d0,sp@
  5123.         bsr     _affii
  5124.         movl    sp@,a0
  5125.         addql   #8,sp
  5126.         bsr     giv
  5127. divsizf:moveml  sp@+,a2-a4
  5128.         unlk    a6
  5129.         rts
  5130. divsir: movl    _avma,a2
  5131.         movw    a3@(2),d0
  5132.         addqw   #1,d0
  5133.         bsr     getr
  5134.         movl    a0,a4
  5135.         movl    a0,sp@-
  5136.         movl    a6@(8),sp@-
  5137.         bsr     _affsr          | conversion dividende en R
  5138.         addql   #2,d0
  5139.         bsr     getr
  5140.         movl    a0,sp@(4)
  5141.         movl    a6@(12),sp@
  5142.         bsr     _affir          | conversion diviseur en R
  5143.         movl    a4,sp@
  5144.         bsr     _divrr
  5145.         movl    a3,sp@(4)
  5146.         movl    d0,sp@
  5147.         bsr     _affrr
  5148.         addql   #8,sp
  5149.         movl    a2,_avma
  5150.         bra     divsizf
  5151.  
  5152. #===================================================================#
  5153. #                                                                   #
  5154. #       Division par valeur : I / S = entier ou reel                #
  5155. #                                                                   #
  5156. #       entree : a7@(4) pointe sur i2 de type I                     #
  5157. #                a7@(8) contient i1 de type S                       #
  5158. #                a7@(12) pointe sur i3 ou r3 de type I ou R         #
  5159. #       sortie : a7@(12) pointe sur i2 / i1 de type I ou R          #
  5160. #                                                                   #
  5161. #===================================================================#
  5162.  
  5163. _divisz:cmpb    #1,sp@(12)@
  5164.         bne     divisr
  5165. divisi: movl    sp@(8),sp@-
  5166.         movl    sp@(8),sp@-
  5167.         bsr     _divis
  5168.         movl    sp@(20),sp@(4)
  5169.         movl    d0,sp@
  5170.         bsr     _affii
  5171.         movl    sp@,a0
  5172.         addql   #8,sp
  5173.         bra     giv
  5174. divisr: movl    _avma,sp@-
  5175.         movw    sp@(16)@(2),d0
  5176.         bsr     getr
  5177.         movl    a0,sp@-
  5178.         movl    sp@(12),sp@-
  5179.         bsr     _affir          | conversion dividende en R
  5180.         movl    sp@(4),sp@      | dividende converti
  5181.         movl    sp@(20),sp@(4)  | diviseur (type S)
  5182.         bsr     _divrs
  5183.         movl    sp@(24),sp@(4)
  5184.         movl    d0,sp@
  5185.         bsr     _affrr
  5186.         addql   #8,sp
  5187.         movl    sp@+,_avma
  5188.         rts
  5189.  
  5190. #===================================================================#
  5191. #                                                                   #
  5192. #       Division par valeur : entier / entier = entier ou reel      #
  5193. #                                                                   #
  5194. #       entree : a7@(4) pointe sur i2 de type I                     #
  5195. #                a7@(8) pointe sur i1 de type I                     #
  5196. #                a7@(12) pointe sur i3 ou r3 de type I ou R         #
  5197. #       sortie : a7@(12) pointe sur i2 / i1 de type I ou R          #
  5198. #                                                                   #
  5199. #===================================================================#
  5200.  
  5201. _diviiz:link    a6,#0
  5202.         moveml  a2-a4,sp@-
  5203.         movl    a6@(16),a3
  5204.         cmpb    #1,a3@
  5205.         bne     diviir
  5206. diviii: movl    a6@(12),sp@-
  5207.         movl    a6@(8),sp@-
  5208.         bsr     _divii
  5209.         movl    a6@(16),sp@(4)
  5210.         movl    d0,sp@
  5211.         bsr     _affii
  5212.         movl    sp@,a0
  5213.         addql   #8,sp
  5214.         bsr     giv
  5215. diviizf:moveml  sp@+,a2-a4
  5216.         unlk    a6
  5217.         rts
  5218. diviir: movl    _avma,a2
  5219.         movw    a3@(2),d0
  5220.         bsr     getr
  5221.         movl    a0,a4
  5222.         movl    a0,sp@-
  5223.         movl    a6@(8),sp@-
  5224.         bsr     _affir          | conversion dividende en R
  5225.         addql   #2,d0
  5226.         bsr     getr
  5227.         movl    a0,sp@(4)
  5228.         movl    a6@(12),sp@
  5229.         bsr     _affir          | conversion diviseur en R
  5230.         movl    a4,sp@
  5231.         bsr     _divrr
  5232.         movl    a3,sp@(4)
  5233.         movl    d0,sp@
  5234.         bsr     _affrr
  5235.         addql   #8,sp
  5236.         movl    a2,_avma
  5237.         bra     diviizf
  5238.  
  5239.  
  5240. #===================================================================#
  5241. #                                                                   #
  5242. #               Division : entier court / entier court = entier     #
  5243. #                                                                   #
  5244. #       entree : a7@(4) contient s2 de type S                       #
  5245. #                a7@(8) contient s1 de type S                       #
  5246. #       sortie : d0 pointe sur s2 div s1 de type I (zone creee)     #
  5247. #                d1.l contient le reste(du signe du dividende)      #
  5248. #                                                                   #
  5249. #===================================================================#
  5250.  
  5251. _divss: link    a6,#0
  5252.         moveml  d2-d3,sp@-
  5253.     moveq    #0,d3
  5254.         movl    a6@(12),d1      | d1.l recoit s1
  5255.         bne     1$
  5256.                                 | ici s1 = 0
  5257.         movl    #diver1,sp@-
  5258.         jsr     _err
  5259.                                 | ici s1 <> 0
  5260. 1$:     movl    a6@(8),d2       | d2.l recoit s2
  5261.     bpl    9$
  5262.     moveq    #-1,d3
  5263. 9$:     divsll  d1,d3:d2
  5264.         bne     2$
  5265.                                 | ici quotient nul
  5266. 3$:     movl    _gzero,d0
  5267.         movl    d3,d1
  5268.         bra     divssg
  5269.                                 | ici quotient non nul
  5270. 2$:     moveq   #3,d0
  5271.         bsr     geti
  5272.         movl    #0x1000003,a0@(4)
  5273.         tstl    d2
  5274.         bpl     4$
  5275.         negl    d2
  5276.         movb    #-1,a0@(4)
  5277. 4$:     movl    d2,a0@(8)
  5278.         movl    d3,d1
  5279. divssf: movl    a0,d0
  5280. divssg: moveml  sp@+,d2-d3
  5281.         unlk    a6
  5282.         rts
  5283.  
  5284. #===================================================================#
  5285. #                                                                   #
  5286. #               Division : entier court / entier = entier           #
  5287. #                                                                   #
  5288. #       entree : a7@(4) contient s2 de type S                       #
  5289. #                a7@(8) contient i1 de type I                       #
  5290. #       sortie : d0 pointe sur s2 div i1 de type I (zone creee)     #
  5291. #                d1.l contient le reste (du signe du dividende)     #
  5292. #                                                                   #
  5293. #===================================================================#
  5294.  
  5295. _divsi: link    a6,#0
  5296.         moveml  d2-d4,sp@-
  5297.         movl    a6@(12),a1      | a1 pointe sur le diviseur i1
  5298.         tstb    a1@(4)
  5299.         bne     1$
  5300.                                 | ici i1 = 0
  5301.         movl    #diver2,sp@-
  5302.         jsr     _err
  5303.                                 | ici i1 <> 0
  5304. 1$:     movl    a6@(8),d2       | d2.l contient le dividende s2
  5305.         bne     3$
  5306.                                 | ici quotient et reste nuls
  5307. 2$:     movl    _gzero,d0
  5308.         moveq   #0,d1
  5309.         bra     divsig
  5310.                                 | ici i1 et s2 <> 0
  5311. 3$:     movw    a1@(6),d1       | d1.w contient le1
  5312.         cmpw    #3,d1
  5313.         beq     4$
  5314.                                 | ici quotient nul et reste=s2
  5315. 6$:     movl    _gzero,a0
  5316.         movl    d2,d1
  5317.         bra     divsif
  5318.                                 | ici L1 = 1
  5319. 4$:     movl    a1@(8),d1       | d1.l contient |i1|
  5320.         movl    d2,d3           | d3.l contient s2
  5321.         bpl     5$
  5322.         negl    d3              | d3.l contient |s2|
  5323. 5$:     moveq   #0,d4
  5324.         divul   d1,d4:d3
  5325.         beq     6$
  5326.         moveq   #3,d0
  5327.         bsr     geti
  5328.         movl    d3,a0@(8)       | ranger mantisse
  5329.         movl    a1@(4),a0@(4)
  5330.         tstl    d2
  5331.         bpl     7$
  5332.         movb    #-1,a0@(4)      | mise a jour du signe
  5333. 7$:     movl    d4,d1
  5334.         tstb    a1@(4)
  5335.         bpl     divsif
  5336.         negl    d1              | mise a jour reste
  5337. divsif: movl    a0,d0
  5338. divsig: moveml  sp@+,d2-d4
  5339.         unlk    a6
  5340.         rts
  5341.  
  5342. #===================================================================#
  5343. #                                                                   #
  5344. #               Division : entier court / reel = reel               #
  5345. #                                                                   #
  5346. #       entree : a7@(4) contient s2 de type S                       #
  5347. #                a7@(8) pointe sur r1 de type R                     #
  5348. #       sortie : d0 pointe sur s2 / r1 de type R (zone creee)       #
  5349. #                                                                   #
  5350. #===================================================================#
  5351.  
  5352. _divsr: link    a6,#-32
  5353.         moveml  d2/a2-a4,sp@-
  5354.         movl    a6@(12),a1      | a1 pointe sur r1
  5355.         tstb    a1@(4)
  5356.         bne     2$
  5357.                                 | ici r1 = 0
  5358.         movl    #diver3,sp@-
  5359.         jsr     _err
  5360.                                 | ici r1 <> 0
  5361. 2$:     tstl    a6@(8)
  5362.         bne     1$
  5363.                                 | ici s2 = 0
  5364.     movl    _gzero,d0
  5365.         bra     divsrf
  5366.                                 | ici s2 et r1 <> 0
  5367. 1$:     moveq   #0,d0
  5368.         movw    a1@(2),d0
  5369.         bsr     getr            | allocation pour resultat
  5370.         movl    a6@(8),d2       | d2.l recoit s2
  5371.         movl    a0,a4
  5372.         addqw   #1,d0
  5373.         bsr     getr
  5374.         movl    a0,sp@-         | sauvegarde adr. copie
  5375.         movl    d2,sp@-
  5376.         bsr     _affsr
  5377.         addql   #4,sp
  5378.         movl    a0,a2           | a2 pointe sur copie s2
  5379.         movl    a4,a0           | a0 pointe sur resultat
  5380.         bsr     dvrr
  5381.         movl    sp@+,a0
  5382.         bsr     giv             | desallouer copie
  5383.         movl    a4,d0
  5384. divsrf: moveml  sp@+,d2/a2-a4   
  5385.         unlk    a6
  5386.         rts
  5387.  
  5388. #===================================================================#
  5389. #                                                                   #
  5390. #               Division : entier / entier court = entier           #
  5391. #                                                                   #
  5392. #       entree : a7@(4) pointe sur i2 de type I                     #
  5393. #                a7@(8) contient s1 de type S                       #
  5394. #       sortie : d0 pointe sur i2 / s1 de type I (zone creee)       #
  5395. #               le reste est dans d1.l (du signe du dividende)      #
  5396. #                                                                   #
  5397. #===================================================================#
  5398.  
  5399. _divis: link    a6,#0
  5400.         moveml  d2-d6/a2,sp@-
  5401.         movl    a6@(12),d1      | d1 recoit s1 diviseur
  5402.         bne     1$
  5403.         movl    #diver4,sp@-
  5404.         jsr     _err
  5405. 1$:     bpl     2$
  5406.         negl    d1
  5407.                                 | ici d1 contient |s1|
  5408. 2$:     movl    a6@(8),a2       | a2 pointe sur i2 dividende
  5409.         movw    a2@(6),d2       | d2 recoit le2
  5410.         movw    a2@(4),d5       | signe de i2
  5411.         bne     4$
  5412.                                 | ici i2=0 : q=0 , r=0
  5413. 3$:     movl    _gzero,d0
  5414.         moveq   #0,d1           | reste nul
  5415.         bra     divisg
  5416.                                 | ici i2 et s1 <>0
  5417. 4$:     movw    d2,d0           | d0 recoit le2
  5418.         addql   #8,a2
  5419.         movl    a2@+,d4
  5420.     moveq    #0,d3
  5421.         divull  d1,d3:d4        | calcul de q0
  5422.         bne     5$
  5423.                                 | ici q0 = 0
  5424.         subqw   #1,d0           | diminuer long. effective
  5425.         cmpw    #2,d0
  5426.         bne     5$
  5427.                                 | ici q=0 , reste dans d3
  5428.     movl    _gzero,a0
  5429.         bra     10$
  5430.                                 | ici q <> 0
  5431. 5$:     bsr     geti
  5432.         movl    a0,a1
  5433.         movw    d0,a0@(6)       | met long. effect.
  5434.         movb    #1,a0@(4)
  5435.         movw    a6@(12),d6      | 'signe de s1'
  5436.         eorw    d5,d6
  5437.         bpl     6$              | si de meme signe
  5438.         movb    #-1,a0@(4)      | si de signes contraires
  5439. 6$:     addql   #8,a1
  5440.         tstl    d4              | q0 = 0 ?
  5441.         beq     7$
  5442.         movl    d4,a1@+         | non: ranger q0
  5443. 7$:     subqw   #3,d2           | d2 recoit L1 -1 compteur
  5444.         bra     9$
  5445. 8$:     movl    a2@+,d4         | boucle de division
  5446.         divul   d1,d3:d4
  5447.         movl    d4,a1@+
  5448. 9$:     dbra    d2,8$
  5449. 10$:    movl    d3,d1           | le reste est mis dans d1
  5450.         tstw    d5              | i1 > 0 ?
  5451.         bpl     divisf
  5452.         negl    d1              | non : changer signe de r
  5453. divisf: movl    a0,d0           | met addresse resultat
  5454. divisg: moveml  sp@+,d2-d6/a2
  5455.         unlk a6
  5456.         rts
  5457.  
  5458. #===================================================================#
  5459. #                                                                   #
  5460. #               Division : entier / entier = entier                 #
  5461. #                                                                   #
  5462. #       entree : a7@(4) pointe sur i2 de type I                     #
  5463. #                a7@(8) pointe sur i1 de type I                     #
  5464. #       sortie : d0 pointe sur i2 / i1 de type I (zone creee)       #
  5465. #                Le reste est du signe du dividende                 #
  5466. #                                                                   #
  5467. #===================================================================#
  5468.  
  5469. _divii: clrl    sp@-
  5470.         movl    sp@(12),sp@-    | empilage de i1
  5471.         movl    sp@(12),sp@-    | empilage de i2
  5472.         bsr     _dvmdii
  5473.         lea     sp@(12),sp      | depilage
  5474.         rts
  5475.  
  5476. #===================================================================#
  5477. #                                                                   #
  5478. #               Division : entier / reel = reel                     #
  5479. #                                                                   #
  5480. #       entree : a7@(4) pointe sur i2 de type I                     #
  5481. #                a7@(8) pointe sur r1 de type R                     #
  5482. #       sortie : d0 pointe sur i2 / r1 de type R (zone creee)       #
  5483. #                                                                   #
  5484. #===================================================================#
  5485.  
  5486. _divir: link    a6,#-32         | var. locales pour appel dvrr
  5487.         moveml  a2-a3,sp@-
  5488.         movl    a6@(12),a1      | a1 pointe sur r1
  5489.         tstb    a1@(4)
  5490.         bne     1$
  5491.                                 | ici r1 = 0
  5492.         movl    #diver5,sp@-
  5493.         jsr     _err
  5494.                                 | ici r1 <> 0
  5495. 1$:     movl    a6@(8),a2       | a2 pointe sur i2
  5496.         tstb    a2@(4)
  5497.         bne     2$
  5498.                                 | ici i2 = 0
  5499.     movl    _gzero,d0
  5500.         bra     divirf
  5501. 2$:     moveq   #0,d0           | ici i2 et r1 <> 0
  5502.         movw    a1@(2),d0       | d0.w contient l1
  5503.         bsr     getr            | allocation pour resultat
  5504.         movl    a0,a3
  5505.         addqw   #1,d0
  5506.         bsr     getr            | allocation pour conversion i2 type R
  5507.         movl    a0,a6@(-16)     | sauvegarde adr. du transforme i2'
  5508.         movl    a0,sp@-
  5509.         movl    a2,sp@-
  5510.         bsr     _affir
  5511.         addql   #8,sp
  5512.         movl    a0,a2           | a2 pointe sur i2'
  5513.         movl    a3,a0           | a0 pointe sur resultat
  5514.         bsr     dvrr
  5515.         movl    a6@(-16),a0
  5516.         bsr     giv             | desallouer i2'
  5517.         movl    a3,d0
  5518. divirf: moveml  sp@+,a2-a3
  5519.         unlk    a6
  5520.         rts
  5521.  
  5522. #===================================================================#
  5523. #                                                                   #
  5524. #               Division : reel / entier court = reel               #
  5525. #                                                                   #
  5526. #       entree : a7@(4) pointe sur r2 de type R                     #
  5527. #                a7@(8) pointe sur s1 de type S                     #
  5528. #       sortie : d0 pointe sur r2 / s1 de type R (zone creee)       #
  5529. #                                                                   #
  5530. #===================================================================#
  5531.  
  5532. _divrs: link    a6,#0
  5533.         moveml  d2-d6/a2,sp@-
  5534.         movl    a6@(12),d1      | d1 recoit s1 diviseur
  5535.         bne     1$
  5536.                                 | ici s1 = 0
  5537.         movl    #diver6,sp@-
  5538.         jsr     _err
  5539.                                 | ici diviseur s1 <> 0
  5540. 1$:     movl    a6@(8),a2       | a2 pointe sur r2 dividende
  5541.         tstb    a2@(4)
  5542.         bne     2$
  5543.                                 | ici r2 = 0
  5544.         moveq   #3,d0
  5545.         bsr     getr
  5546.         tstl    d1
  5547.         bpl     11$
  5548.         negl    d1
  5549. 11$:    bfffo   d1{#0:#0},d0
  5550.         addl    a2@(4),d0
  5551.         subl    #31,d0
  5552.         bmi     9$
  5553.         movl    d0,a0@(4)
  5554.         clrl    a0@(8)
  5555.         bra     divrsf
  5556.                                 | ici r2 et s1 <> 0
  5557. 2$:     movw    a2@(2),d0       | d0 recoit l2
  5558.         bsr     getr            | allocation pour resultat
  5559.         movb    a2@(4),a0@(4)   | signe de r2
  5560.         tstl    d1
  5561.         bpl     3$
  5562.         negl    d1              | d1 recoit |s1| <= 2^31
  5563.                                 | s1 est tjrs <= 1er mot mantisse
  5564.                                 | le 1er quotient partiel est non nul
  5565.         negb    a0@(4)
  5566. 3$:     movl    a0,a1
  5567.         addql   #8,a1
  5568.         addql   #8,a2
  5569.         subqw   #3,d0           | d0 recoit L2-1 compteur
  5570.         movl    d0,d2           | conserve dans d2
  5571.         moveq   #0,d3           | 1er reste
  5572. 4$:     movl    a2@+,d4
  5573.         divul   d1,d3:d4
  5574.         movl    d4,a1@+
  5575.         dbra    d0,4$           | boucle de division
  5576.  
  5577.         movl    a0@(8),d0       | resultat normalise ?
  5578.         bpl     10$
  5579.         moveq   #0,d1           | ici normalise ; nb shift = 0
  5580.         bra     5$
  5581.                                 | ici il faut normaliser
  5582.  
  5583. 10$:    moveq   #0,d4
  5584.         divul   d1,d3:d4        | traite dernier reste: quotient
  5585.                                 | a recuperer par le shift
  5586.         bfffo   d0{#0:#0},d1    | nb de shift dans d1
  5587.         lsll    d1,d0           | shift 1er lg mot d0
  5588.         movl    a0,a1
  5589.         addql   #8,a1
  5590.         moveq   #1,d6
  5591.         lsll    d1,d6
  5592.         subql   #1,d6           | d6 masque de shift
  5593.         bra     7$
  5594. 6$:     movl    a1@(4),d3
  5595.         roll    d1,d3
  5596.         movl    d3,d5
  5597.         andl    d6,d3
  5598.         addl    d3,d0
  5599.         movl    d0,a1@+
  5600.         subl    d3,d5
  5601.         movl    d5,d0
  5602. 7$:     dbra    d2,6$
  5603.         roll    d1,d4           | shifter dernier quotient
  5604.         andl    d6,d4
  5605.         addl    d4,d0
  5606.         movl    d0,a1@
  5607. 5$:     movl    a6@(8),a2       | a2 pointe sur r2 dividende
  5608.         movl    a2@(4),d2
  5609.         andl    #0xffffff,d2    | exposant biaise de r2
  5610.         subl    d1,d2           | exposant resultat
  5611.         bpl     8$
  5612.                                 | ici underflow
  5613. 9$:     movl    #diver7,sp@-
  5614.         jsr     _err
  5615. 8$:     movw    d2,a0@(6)
  5616.         swap    d2
  5617.         movb    d2,a0@(5)       | range exposant
  5618. divrsf: movl    a0,d0
  5619.         moveml  sp@+,d2-d6/a2
  5620.         unlk    a6
  5621.         rts
  5622.  
  5623.  
  5624. #===================================================================#
  5625. #                                                                   #
  5626. #               Division : reel / entier = reel                     #
  5627. #                                                                   #
  5628. #       entree : a7@(4) pointe sur r2 de type R                     #
  5629. #                a7@(8) pointe sur i1 de type I                     #
  5630. #       sortie : d0 pointe sur r2 / i1 de type R (zone creee)       #
  5631. #                                                                   #
  5632. #===================================================================#
  5633.  
  5634. _divri: link    a6,#-32         | var. locales pour appel dvrr
  5635.         moveml  d2-d3/a2-a3,sp@-
  5636.         movl    a6@(12),a1      | a1 pointe sur le diviseur i1
  5637.         tstb    a1@(4)
  5638.         bne     1$
  5639.                                 | ici i1 = 0
  5640.         movl    #diver8,sp@-
  5641.         jsr     _err
  5642.                                 | ici i1 <> 0
  5643. 1$:     movl    a6@(8),a2       | a2 pointe sur le dividende r2
  5644.         tstb    a2@(4)
  5645.         bne     2$
  5646.                                 | ici r2 = 0
  5647.         moveq   #3,d0
  5648.         bsr     getr
  5649.         movw    a1@(6),d0
  5650.         lsll    #5,d0
  5651.         bfffo   a1@(8){#0:#0},d1
  5652.         addl    a2@(4),d1
  5653.         addl    #65,d1
  5654.         subl    d0,d1
  5655.         bpl     3$
  5656.         movl    #diver12,sp@-   | underflow R/I avec R = 0
  5657.         jsr     _err
  5658. 3$:     movl    d1,a0@(4)       
  5659.         clrl    a0@(8)
  5660.         movl    a0,d0
  5661.         bra     divrif
  5662.                                 | ici r2 et i1 <> 0
  5663. 2$:     moveq   #0,d0
  5664.         movw    a2@(2),d0
  5665.         bsr     getr            | allocation pour resultat
  5666.     movl    _avma,a3        | eviter le chevauchement.
  5667.     subql    #8,a3
  5668.     movl    a3,_avma
  5669.     movl    #2,a3@        | Hack pour que giv rende ceci
  5670.         movl    a0,a3           | sauvegarde adr. resultat
  5671.         addqw   #1,d0
  5672.         bsr     getr            | allocation pour conversion i1 type R
  5673.         movl    a0,a6@(-16)     | sauvegarde adr. copie
  5674.         movl    a0,sp@-
  5675.         movl    a1,sp@-
  5676.         bsr     _affir
  5677.         addql   #8,sp
  5678.         movl    a0,a1           | a1 pointe sur copie i1
  5679.         movl    a3,a0           | a0 pointe sur resultat
  5680.         bsr     dvrr
  5681.         movl    a6@(-16),a0
  5682.         bsr     giv             | desallouer copie
  5683.         movl    a3,d0
  5684. divrif: moveml  sp@+,d2-d3/a2-a3
  5685.         unlk    a6
  5686.         rts
  5687.  
  5688. #===================================================================#
  5689. #                                                                   #
  5690. #               Division : reel / reel = reel                       #
  5691. #                                                                   #
  5692. #       entree : a7@(4) pointe sur r2 de type R                     #
  5693. #                a7@(8) pointe sur r1 de type R                     #
  5694. #       sortie : d0 pointe sur r2 / r1 de type R (zone creee)       #
  5695. #       precision : L = inf ( L1 , L2 )                             #
  5696. #                                                                   #
  5697. #===================================================================#
  5698.  
  5699. _divrr: link    a6,#-32         | var. locales pour appel dvrr
  5700.         movl    a2,sp@-
  5701.         movl    a6@(12),a1      | a1 pointe sur r1=y diviseur
  5702.         movl    a6@(8),a2       | a2 pointe sur r2=x dividende
  5703.         tstb    a1@(4)          | r1 = 0 ?
  5704.         bne     1$
  5705.                                 | ici r1 = 0
  5706.         movl    #diver9,sp@-
  5707.         jsr     _err
  5708. 1$:     tstb    a2@(4)          | r2 = 0 ?
  5709.         bne     3$
  5710.                                 | ici r2=0, r1<>0 : resultat nul
  5711.         moveq   #3,d0
  5712.         bsr     getr
  5713.         movl    a1@(4),d0       
  5714.         andl    #0xffffff,d0    | exposant de r1
  5715.         subl    a2@(4),d0
  5716.         negl    d0
  5717.         addl    #0x800000,d0
  5718.         cmpl    #0x1000000,d0
  5719.         bcs     4$
  5720.         movl    #diver11,sp@-   | debordement r/r
  5721.         jsr     _err
  5722. 4$:     tstl    d0
  5723.         bgt     5$
  5724.         movl    #diver10,sp@-   | underflow r/r
  5725.         jsr     _err
  5726. 5$:     movl    d0,a0@(4)
  5727.         clrl    a0@(8)
  5728.         bra     divrrf
  5729. 3$:     movw    a1@(2),d0
  5730.         cmpw    a2@(2),d0
  5731.         bls     2$
  5732.         movw    a2@(2),d0       | d0 recoit l=inf(l1,l2)
  5733. 2$:     bsr     getr
  5734.         bsr     dvrr            | effectuer la division !
  5735. divrrf: movl    a0,d0
  5736.         movl    sp@,a2
  5737.         unlk    a6
  5738.         rts
  5739.  
  5740. #===================================================================#
  5741. #                                                                   #
  5742. #       module interne de division r/r (pour R/R,R/I,I/R et S/R)    #
  5743. #       --------------------------------------------------------    #
  5744. #       entree : a1 et a2 pointent sur 2 reels r1 et r2             #
  5745. #       tous 2 non nuls.                                            #
  5746. #       a0 pointe sur un type reel de longueur l=inf(l1,l2)         #
  5747. #       ce module a besoin de variables locales reservees et        #
  5748. #       pointees par a6 dans le programme appelant.                 #
  5749. #       sortie : le quotient r2/r1 est mis a l'addresse initiale a0 #
  5750. #       (qui n'est pas affectee)                                    #
  5751. #===================================================================#
  5752.  
  5753. dvrr:   moveml  d2-d7/a2-a4,sp@-
  5754.         movb    a1@(4),d1       | signe de r1
  5755.         movb    a2@(4),d2       | signe de r2
  5756.         eorb    d2,d1                                   
  5757.         addqb   #1,d1
  5758.         movb    d1,a6@(-2)      | sauvegarde signe resultat
  5759.         movl    a2@(4),d2
  5760.         andl    #0xffffff,d2
  5761.         movl    a1@(4),d1
  5762.         andl    #0xffffff,d1
  5763.         subl    d1,d2          
  5764.         addl    #0x800000,d2    | exposant provisoire avec offset
  5765.         movl    d2,a6@(-6)      | sauvegarde
  5766.  
  5767.         movw    a0@(2),d0       | d0.w recoit longueur resultat ( inf(l1,l2) )
  5768.         movw    a1@(2),d1
  5769.     cmpw    #3,d1        | diviseur de longeur 3 ?
  5770.     bne    5$
  5771.     movl    a1@(8),d1    
  5772.     movl    a2@(8),d3
  5773.     clrl    d2
  5774.     cmpw    #3,a2@(2)
  5775.     beq    7$
  5776.     movl    a2@(12),d2
  5777. 7$:    cmpl    d3,d1
  5778.     bls    6$
  5779.     divul    d1,d3:d2
  5780.     movl    d2,a0@(8)
  5781.     movl    a6@(-6),d0    | ici mantisse correcte, soustraire 1 a l'exposant
  5782.     subql    #1,d0
  5783.     bra    comd2
  5784. 6$:    lsrl    #1,d3
  5785.     roxrl    #1,d2        | shifter de 1 a droite le quadword
  5786.     divul    d1,d3:d2
  5787.     movl    d2,a0@(8)
  5788.     movl    a6@(-6),d0    | exposant correct
  5789.     bra     comd2
  5790. 5$:     subw    d0,d1           | flag nombre de mots du diviseur
  5791.         movw    d1,a6@(-28)     | a sauvegarder.
  5792.         subqw   #2,d0
  5793.         movw    d0,d7           | d0 et d7 recoit m=inf(l1,l2)-2
  5794.         movw    d7,a6@(-12)     | d7 sera compt boucle externe
  5795.         movl    a0@,a6@(-10)    | sauvegarde 1er lg mot code resultat
  5796.                                 | (on a besoin de toute la place)
  5797.     movw    a2@(2),d6
  5798.     subqw    #2,d6        | sauvegarde l2-2
  5799.         addql   #8,a2           | a2 pointe sur y1 (1er mot dividende
  5800.                                 | on note y=y1y2...ym le dividende
  5801.         movl    a0,a4
  5802.         clrl    a4@+
  5803. 1$:     movl    a2@+,a4@+       | on recopie m+1 lgmots mantisse de y
  5804.         dbra    d0,1$           | precede par un zero
  5805.     cmpw    d7,d6        | l2>l1 ?
  5806.     bgt    4$
  5807.     clrl    a4@(-4)        | Si l2<=l1, y(m+1) n'existe pas 
  5808.                                 | a4 pointe apres y(m+1)
  5809. 4$:     movl    a0,a2           | a2 pointe sur y0=0 1er mot dividende
  5810.         addql   #8,a1           | a1 pointe sur x1 1er mot diviseur
  5811.         lea     a1@(8,d7:w:4),a3| a3 pointe apres x(m+2)
  5812.         movl    a3,a6@(-32)
  5813.         movw    a6@(-28),d6     | (peut etre n'importe quoi mais va etre
  5814.         bne     2$              | corrige)
  5815.         movl    a3@(-8),a6@(-20)
  5816.         clrl    a3@(-8)
  5817. 2$:     subqw   #1,d6
  5818.         bgt     3$
  5819.         movl    a3@(-4),a6@(-24)
  5820.         clrl    a3@(-4)
  5821. 3$:     moveq   #0,d6           | d6 recoit 0 pour les addx
  5822.  
  5823.                                 | Boucles de division R/R
  5824.                                 | d7 compt bcl externe initialise a m
  5825.                                 | pour trouver q0q1...qm
  5826.                                 | d0 compt bcl interne initialise
  5827.                                 | par d7 a chaque tour
  5828. #...................................................................#
  5829. dext:   movl    a1@,d0          | d0 recoit x1 (1er mot diviseur)
  5830.         cmpl    a2@,d0          | compare a yi
  5831.         bne     1$
  5832.         movl    #-1,d1          | essayer q=2^32-1
  5833.         addl    a2@(4),d0
  5834.         bcs     4$
  5835.         movl    d0,d2
  5836.         bra     2$
  5837. 1$:     movl    a2@,d2          | d2 recoit yi
  5838.         movl    a2@(4),d1       | d2:d1 recoit yiy(i+1)
  5839.         divul   d0,d2:d1        | d1 recoit q = yiy(i+1) div x1
  5840.                                 | d2 recoit r = yiy(i+1) mod x1
  5841. 2$:     movl    a1@(4),d3       | d3 recoit x2
  5842.         mulul   d1,d4:d3        | d4:d3 recoit q*x2
  5843.         subl    a2@(8),d3
  5844.         subxl   d2,d4           | d4:d3 recoit q*x2-(r,y(i+2))
  5845.         bls     4$
  5846.         
  5847. 3$:     subql   #1,d1           | ici q est trop grand : q-1
  5848.         subl    a1@(4),d3
  5849.         subxl   d0,d4           | correction du reste partiel
  5850.         bhi     3$              | boucler tant que trop
  5851.                                 | ici q =yiy(i+1)y(i+2) div x1x2 correct
  5852.                                 | on va calculer le reste partiel
  5853. 4$:     movw    d7,d0           | d0  recoit m-i compteur
  5854.         movl    a3,a1           | a3,a1 pointent apres y(m+2-i)
  5855.         movl    a4,a2           | a4,a2 pointent apres y(m+1)
  5856.         movl    a1@-,d2
  5857.         mulul   d1,d3:d2        | initialise retenue d3 par
  5858.         subl    d2,d2           | poids fort de q*y(m+2-i). d2 et X a 0
  5859. 5$:     movl    a1@-,d5
  5860.         mulul   d1,d4:d5        | boucle interne de multiplication et
  5861.         addxl   d3,d5           | soustraction :
  5862.         addxl   d2,d4           | yi...y(m+1) recoit yi...y(m+1)-
  5863.         subl    d5,a2@-         |      q*x1...x(m+1-i)
  5864.         movl    d4,d3
  5865.         dbra    d0,5$
  5866.         addxl   d2,d3
  5867.         subl    d3,a2@(-4)
  5868.         bcc     6$
  5869.                                 | ici carry: q encore 1 de trop
  5870.         subql   #1,d1
  5871.         movw    d7,d0
  5872.         movl    a3,a1
  5873.         movl    a4,a2
  5874.         subql   #4,a1           | correction sur a1 (car on avait prevu
  5875.                                 | d'initialiser la retenue)
  5876. 7$:     addxl   a1@-,a2@-
  5877.         dbra    d0,7$           | boucle de readdition(met reste a jour)
  5878. 6$:     movl    d1,a2@(-4)      | qi correct ! ranger a la place de xi
  5879.         subql   #4,a3           | a3 p. un mot de moins pour bcle suiv.
  5880.                                 | a3 pointe sur x(m-i+1)
  5881. bcdf:   dbra    d7,dext         | fin de boucle externe de division
  5882. #...................................................................#
  5883.     movl    a6@(-32),a3
  5884.         movw    a6@(-28),d5     | remise eventuelle de xm+1 et xm+2
  5885.         bne     7$
  5886.         movl    a6@(-20),a3@(-8)
  5887. 7$:     subqw   #1,d5
  5888.         bgt     8$
  5889.         movl    a6@(-24),a3@(-4)
  5890. 8$:     movw    a6@(-12),d5
  5891.         movw    d5,d4           | d4 recoit m
  5892. 6$:     movl    a2@-,a2@(4)
  5893.         dbra    d5,6$
  5894.         movl    a6@(-10),a2@+   | 1er lg mot code;a2 pointe sur q1
  5895.         movl    a6@(-6),d0      | exposant biaise
  5896.         movl    a2@,d1          | d1 recoit q0=0 ou 1
  5897.         bne     1$
  5898.                                 | ici q0=0 : mantisse correcte
  5899.         subql   #1,d0           | retrancher 1 a l'exposant
  5900.         bra     comd2
  5901. 1$:     addql   #4,a2           | ici q0=1 : shifter de 1 a droite
  5902.         subqw   #1,d4           | d4 recoit m-1
  5903.         asrw    #1,d1           | met carry flag
  5904. 5$:     roxrw   a2@+
  5905.         roxrw   a2@+
  5906.         dbra    d4,5$           | boucle de normalisation
  5907. comd2:  cmpl    #0x1000000,d0
  5908.         ble     3$
  5909.         movl    #diver10,sp@-   | underflow
  5910.         jsr     _err
  5911. 3$:     bcs     4$
  5912.         movl    #diver11,sp@-   | overflow
  5913.         jsr     _err
  5914. 4$:     movl    d0,a0@(4)       | range exposant
  5915.         movb    a6@(-2),a0@(4)  | range signe
  5916.         moveml  sp@+,d2-d7/a2-a4
  5917. dvrrf:  rts
  5918.  
  5919.  
  5920.  
  5921.  
  5922. #*******************************************************************#
  5923. #*******************************************************************#
  5924. #**                                                               **#
  5925. #**                     PROGRAMMES D ' INVERSION                  **#
  5926. #**             ( programmes par valeurs : le resultat est        **#
  5927. #*                      mis dans un REEL existant deja  )         **#
  5928. #**                                                               **#
  5929. #*******************************************************************#
  5930. #*******************************************************************#
  5931.  
  5932.  
  5933. _mpinvsr:movl   sp@(8),sp@-
  5934.         movl    sp@(8),sp@-
  5935.         pea     1
  5936.         bsr     divssr
  5937.         lea     sp@(12),sp
  5938.         rts
  5939.  
  5940. _mpinvz:cmpb    #1,sp@(4)@
  5941.         bne     _mpinvrr
  5942.  
  5943. _mpinvir:movl   sp@(8),sp@-
  5944.         movl    sp@(8),sp@-
  5945.         pea     1
  5946.         bsr     _divsiz
  5947.         lea     sp@(12),sp
  5948.         rts
  5949.  
  5950. _mpinvrr:movl   sp@(8),sp@-
  5951.         movl    sp@(8),sp@-
  5952.         pea     1
  5953.         bsr     _divsrz
  5954.         lea     sp@(12),sp
  5955.         rts
  5956.  
  5957.  
  5958.  
  5959. #*******************************************************************#
  5960. #*******************************************************************#
  5961. #**                                                               **#
  5962. #**                     PROGRAMMES MODULO                         **#
  5963. #**                                                               **#
  5964. #*******************************************************************#
  5965. #*******************************************************************#
  5966.  
  5967.  
  5968.  
  5969.  
  5970.  
  5971.  
  5972. #===================================================================#
  5973. #                                                                   #
  5974. #                       Modulo (par valeur)                         #
  5975. #                                                                   #
  5976. #       entree : a7@(4) pointe sur n2 de type I                     #
  5977. #                a7@(8) pointe sur n1 de type I                     #
  5978. #                a7@(12) pointe sur n3 de type I                    #
  5979. #       sortie : la zone pointee par a7@(12) contient le reste de   #
  5980. #                la division de n2 par n1                           #
  5981. #                compris entre 0 et abs(n1)-1                       #
  5982. #       interdit : type S et R                                      #
  5983. #                                                                   #
  5984. #===================================================================#
  5985.  
  5986. _mpmodz:lea     _modii,a0
  5987.         bra     mpopi
  5988.  
  5989.                                 | modulo S mod S = I sinon erreur
  5990.  
  5991. _modssz:lea     _modss,a0
  5992.         bra     mpopi
  5993.  
  5994.                                 | modulo S mod I = I sinon erreur
  5995.  
  5996. _modsiz:lea     _modsi,a0
  5997.         bra     mpopi
  5998.  
  5999.                                 | modulo I mod S = I sinon erreur
  6000.  
  6001. _modisz:lea     _modis,a0
  6002.         bra     mpopi
  6003.  
  6004.                                 | modulo I mod I = I sinon erreur
  6005.  
  6006. _modiiz:lea     _modii,a0
  6007.         bra     mpopi
  6008.  
  6009. #===================================================================#
  6010. #                                                                   #
  6011. #               entier court Modulo entier court = entier           #
  6012. #                                                                   #
  6013. #       entree : a7@(4) contient s2 de type S                       #
  6014. #                a7@(8) contient s1 de type S                       #
  6015. #       sortie : d0 pointe sur s2 mod s1 de type I (zone creee)     #
  6016. #                compris entre 0 et abs(s1)-1                       #
  6017. #                                                                   #
  6018. #===================================================================#
  6019.  
  6020. _modss: link    a6,#0
  6021.         moveml  d2-d3,sp@-
  6022.     moveq    #0,d3
  6023.         movl    a6@(12),d1      | d1.l contient s1
  6024.         bne     1$
  6025.                                 | ici s1 = 0
  6026.         movl    #moder1,sp@-
  6027.         jsr     _err
  6028.                                 | ici s1 <> 0
  6029. 1$:     movl    a6@(8),d2       | d2.l contient s2
  6030.     bpl    9$
  6031.     moveq    #-1,d3
  6032. 9$:     divsll  d1,d3:d2
  6033.         tstl    d3
  6034.         bne     2$
  6035.                                 | ici reste nul
  6036. 3$:     movl    _gzero,d0
  6037.         bra     modssf
  6038.                                 | ici reste non nul
  6039. 2$:     bmi     5$
  6040.                                 | ici reste > 0
  6041.         moveq   #3,d0
  6042.         bsr     geti
  6043.         movl    #0x1000003,a0@(4)
  6044.         movl    d3,a0@(8)
  6045.         bra 7$
  6046.                                 | ici reste < 0
  6047. 5$:     movl    a6@(12),sp@-
  6048.         movl    d3,sp@-
  6049.         tstl    d1
  6050.         bpl     6$
  6051.                                 | ici s1 < 0
  6052.         bsr     _subss
  6053.         addql   #8,sp
  6054.         bra     modssf
  6055.                                 | ici s1 > 0
  6056. 6$:     bsr     _addss
  6057.         addql   #8,sp
  6058.         bra     modssf
  6059. 7$:     movl    a0,d0
  6060. modssf: moveml  sp@+,d2-d3
  6061.         unlk    a6
  6062.         rts
  6063.  
  6064. #===================================================================#
  6065. #                                                                   #
  6066. #               entier court Modulo entier = entier                 #
  6067. #                                                                   #
  6068. #       entree : a7@(4) contient s2 de type S                       #
  6069. #                a7@(8) ppinte sur i1 de type I                     #
  6070. #       sortie : d0 pointe sur s2 mod i1 de type I (zone creee)     #
  6071. #                compris entre 0 et abs(i1)-1                       #
  6072. #                                                                   #
  6073. #===================================================================#
  6074.  
  6075. _modsi: link    a6,#0
  6076.         moveml  d2-d3,sp@-
  6077.         movl    a6@(12),sp@-
  6078.         movl    a6@(8),sp@-
  6079.         bsr     _divsi
  6080.         addql   #8,sp
  6081.         movl    d0,a0
  6082.         bsr     giv             | desallouer memoire provisoire
  6083.         tstl    d1              | tester le reste
  6084.         bne     1$
  6085.                                 | ici reste nul
  6086.         movl    _gzero,d0
  6087.         bra     modsif
  6088.                                 | ici reste non nul
  6089. 1$:     bmi     3$
  6090.                                 | ici reste > 0
  6091.         movl    d1,d3           | d3.l recoit le reste
  6092.         moveq   #3,d0
  6093.         bsr     geti
  6094.         movl    #0x1000003,a0@(4)
  6095.         movl    d3,a0@(8)
  6096.         bra     2$
  6097.                                 | ici reste < 0
  6098. 3$:     movl    a6@(12),sp@-
  6099.         movl    d1,sp@-
  6100.         movl    a6@(12),a1      | a1 pointe sur i1
  6101.         tstb    a1@(4)
  6102.         bpl     5$
  6103.                                 | ici i1 < 0
  6104.         bsr     _subsi
  6105.         bra     6$
  6106.                                 | ici i1 > 0
  6107. 5$:     bsr     _addsi
  6108. 6$:     addql   #8,sp
  6109.         bra     modsif
  6110. 2$:     movl    a0,d0
  6111. modsif: moveml  sp@+,d2-d3
  6112.         unlk    a6
  6113.         rts
  6114.  
  6115. #===================================================================#
  6116. #                                                                   #
  6117. #               entier Modulo entier court = entier                 #
  6118. #                                                                   #
  6119. #       entree : a7@(4) pointe sur i2 de type I                     #
  6120. #                a7@(8) contient s1 de type S                       #
  6121. #       sortie : d0 pointe sur i2 mod s1 de type I (zone creee)     #
  6122. #                compris entre 0 et abs(s1)-1                       #
  6123. #                                                                   #
  6124. #===================================================================#
  6125.  
  6126. _modis: link    a6,#0
  6127.         moveml  d2-d3,sp@-
  6128.         movl    a6@(12),sp@-
  6129.         movl    a6@(8),sp@-
  6130.         bsr     _divis
  6131.         addql   #8,sp
  6132.         movl    d0,a0
  6133.         bsr     giv
  6134.         tstl    d1
  6135.         bne     1$
  6136.                                 | ici reste nul
  6137.     movl    _gzero,d0
  6138.         bra     modisf
  6139.                                 | ici reste non nul
  6140. 1$:     bmi     3$
  6141.                                 | ici reste > 0
  6142.         movl    d1,d3
  6143.         moveq   #3,d0
  6144.         bsr     geti
  6145.         movl    #0x1000003,a0@(4)
  6146.         movl    d3,a0@(8)
  6147.         bra     2$
  6148.                                 | ici reste < 0
  6149. 3$:     movl    a6@(12),sp@-
  6150.         movl    d1,sp@-
  6151.         movl    a6@(12),d1      | d1.l contient s1
  6152.         bpl     5$
  6153.         bsr     _subss
  6154.         bra     6$
  6155. 5$:     bsr     _addss
  6156. 6$:     addql   #8,sp
  6157.         bra     modisf
  6158. 2$:     movl    a0,d0
  6159. modisf: moveml  sp@+,d2-d3
  6160.         unlk    a6
  6161.         rts
  6162.  
  6163. #===================================================================#
  6164. #                                                                   #
  6165. #               entier Modulo entier = entier                       #
  6166. #                                                                   #
  6167. #       entree : a7@(4) pointe sur i2 de type I                     #
  6168. #                a7@(8) pointe sur i1 de type I                     #
  6169. #       sortie : d0 pointe sur i2 mod i1 de type I                  #
  6170. #                compris entre 0 et abs(i1)-1(zone creee)           #
  6171. #                                                                   #
  6172. #===================================================================#
  6173.  
  6174. _modii: link    a6,#-4
  6175.         movl    #-1,sp@-
  6176.         movl    a6@(12),sp@-    | empilage adresse i1
  6177.         movl    a6@(8),sp@-     | empilage adresse i2
  6178.         movl    _avma,a6@(-4)   | sauvegarde adr. tete pile PARI
  6179.         bsr     _dvmdii
  6180.         movl    d0,a1           | a1 pointe sur resultat
  6181.         tstb    a1@(4)
  6182.         bpl     modiif
  6183.                                 | ici reste negatif
  6184.         movl    a1,sp@          | empilage adr. du reste
  6185.         tstb    a6@(12)@(4)     | test signe du modulo
  6186.         bpl     1$
  6187.         bsr     _subii
  6188.         bra     2$
  6189. 1$:     bsr     _addii
  6190. 2$:     movl    sp@+,a1
  6191.         movl    _avma,a0
  6192.         movw    a0@(2),d0
  6193.         subqw   #1,d0
  6194.         movl    a6@(-4),a0      | a0 pointe sur pile initiale
  6195. 3$:     movl    a1@-,a0@-
  6196.         dbra    d0,3$           | ecraser resultat intermediaire
  6197.         movl    a0,_avma
  6198.         movl    a0,d0           | nouvelle adresse resultat
  6199. modiif: unlk    a6
  6200.         rts
  6201.  
  6202.  
  6203.  
  6204.  
  6205.  
  6206. #*******************************************************************#
  6207. #*******************************************************************#
  6208. #**                                                               **#
  6209. #**     PROGRAMMES DE RESTE DES DIVISIONS ENTIERES                **#
  6210. #**                                                               **#
  6211. #*******************************************************************#
  6212. #*******************************************************************#
  6213.  
  6214.  
  6215.  
  6216.  
  6217.  
  6218. #===================================================================#
  6219. #                                                                   #
  6220. #                       Reste (par valeur)                          #
  6221. #                                                                   #
  6222. #       entree : a7@(4) pointe sur n2 de type I                     #
  6223. #                a7@(8) pointe sur n1 de type I                     #
  6224. #                a7@(12) pointe sur n3 de type I                    #
  6225. #       sortie : la zone pointee par a7@(12) contient le reste de   #
  6226. #                la division de n2 par n1 (du signe du dividende)   #
  6227. #       interdit : type S et R                                      #
  6228. #                                                                   #
  6229. #===================================================================#
  6230.  
  6231. _mpresz:lea     _resii,a0
  6232.         bra     mpopi
  6233.  
  6234.                                 | reste de S/S = I sinon erreur
  6235.  
  6236. _resssz:lea     _resss,a0
  6237.         bra     mpopi
  6238.  
  6239.                                 | reste de S/I = I sinon erreur
  6240.  
  6241. _ressiz:lea     _ressi,a0
  6242.         bra     mpopi
  6243.  
  6244.                                 | reste de I/S = I sinon erreur
  6245.  
  6246. _resisz:lea     _resis,a0
  6247.         bra     mpopi
  6248.  
  6249.                                 | reste de I/I = I sinon erreur
  6250.  
  6251. _resiiz:lea     _resii,a0
  6252.         bra     mpopi
  6253.  
  6254. #===================================================================#
  6255. #                                                                   #
  6256. #               Reste : entier court / entier court = entier        #
  6257. #                                                                   #
  6258. #       entree : a7@(4) contient s2 de type S                       #
  6259. #                a7@(8) contient s1 de type S                       #
  6260. #       sortie : d0 pointe sur le reste de la division s2 / s1      #
  6261. #                de type I (zone creee)                             #
  6262. #                Le reste est du signe du dividende                 #
  6263. #                                                                   #
  6264. #===================================================================#
  6265.  
  6266. _resss: link    a6,#0
  6267.         moveml  d2-d3,sp@-
  6268.     moveq    #0,d3
  6269.         movl    a6@(12),d1      | d1.l contient le diviseur s1
  6270.         bne     1$
  6271.                                 | ici s1 = 0
  6272.         movl    #reser1,sp@-
  6273.         jsr     _err
  6274.                                 | ici s1 <> 0
  6275. 1$:     movl    a6@(8),d2       | d2.l contient s2
  6276.     bpl    9$
  6277.     moveq    #-1,d3
  6278. 9$:     divsll  d1,d3:d2
  6279.         tstl    d3
  6280.         bne     2$
  6281.                                 | ici reste nul
  6282.     movl    _gzero,d0
  6283.         bra     resssg
  6284.                                 | ici reste non nul
  6285. 2$:     moveq   #3,d0
  6286.         bsr     geti
  6287.         movl    #0x1000003,a0@(4)
  6288.         tstl    d3
  6289.         bpl     3$
  6290.         negl    d3
  6291.         movb    #-1,a0@(4)
  6292. 3$:     movl    d3,a0@(8)
  6293. resssf: movl    a0,d0
  6294. resssg: moveml  sp@+,d2-d3
  6295.         unlk    a6
  6296.         rts
  6297.  
  6298. #===================================================================#
  6299. #                                                                   #
  6300. #               Reste : entier court / entier = entier              #
  6301. #                                                                   #
  6302. #       entree : a7@(4) contient s2 de type S                       #
  6303. #                a7@(8) pointe sur i1 de type I                     #
  6304. #       sortie : d0 pointe sur le reste de la division s2 / i1      #
  6305. #                de type I (zone creee)                             #
  6306. #                Le reste est du signe du dividende                 #
  6307. #                                                                   #
  6308. #===================================================================#
  6309.  
  6310. _ressi: movl    sp@(8),sp@-     | empilage adr. i1
  6311.         movl    sp@(8),sp@-     | empilage s2
  6312.         bsr     _divsi
  6313.         movl    d0,a0           | a0 pointe sur resultat prov.
  6314.         bsr     giv
  6315.         tstl    d1              | d1.l contient le reste
  6316.         bne     1$
  6317.                                 | ici reste nul
  6318.     movl    _gzero,d0
  6319.         bra     ressig
  6320.                                 | ici reste non nul
  6321. 1$:     moveq   #3,d0
  6322.         bsr     geti
  6323.         movl    #0x1000003,a0@(4)
  6324.         tstl    d1
  6325.         bpl     2$
  6326.         negl    d1
  6327.         movb    #-1,a0@(4)
  6328. 2$:     movl    d1,a0@(8)
  6329. ressif: movl    a0,d0
  6330. ressig: addql   #8,sp
  6331.         rts
  6332.  
  6333. #===================================================================#
  6334. #                                                                   #
  6335. #               Reste : entier / entier court = entier              #
  6336. #                                                                   #
  6337. #       entree : a7@(4) pointe sur i2 de type I                     #
  6338. #                a7@(8) contient s1 de type S                       #
  6339. #       sortie : d0 pointe sur le reste de la division i2 / s1      #
  6340. #                (zone creee)                                       #
  6341. #                Le reste est du signe du dividende                 #
  6342. #                                                                   #
  6343. #===================================================================#
  6344.  
  6345. _resis: movl    sp@(8),sp@-     | empilage s1
  6346.         movl    sp@(8),sp@-     | empilage adr.i2
  6347.         bsr     _divis
  6348.         movl    d0,a0
  6349.         bsr     giv             | desallouer memoire provisoire
  6350.         tstl    d1              | le reste est dans d1.l
  6351.         bne     1$
  6352.                                 | ici reste nul
  6353.     movl    _gzero,d0
  6354.         bra     resisg
  6355.                                 | ici reste non nul
  6356. 1$:     moveq   #3,d0
  6357.         bsr     geti
  6358.         movl    #0x1000003,a0@(4)
  6359.         tstl    d1
  6360.         bpl     2$
  6361.         negl    d1
  6362.         movb    #-1,a0@(4)
  6363. 2$:     movl    d1,a0@(8)
  6364. resisf: movl    a0,d0
  6365. resisg: addql   #8,sp
  6366.         rts
  6367.  
  6368. #===================================================================#
  6369. #                                                                   #
  6370. #               Reste : entier / entier = entier                    #
  6371. #                                                                   #
  6372. #       entree : a7@(4) pointe sur i2 de type I                     #
  6373. #                a7@(8) pointe sur i1 de type I                     #
  6374. #       sortie : d0 pointe sur le reste de la division i2 / i1      #
  6375. #                de type I (zone creee)                             #
  6376. #                ( du signe du dividende)                           #
  6377. #                                                                   #
  6378. #===================================================================#
  6379.  
  6380. _resii: movl    #-1,sp@-
  6381.         movl    sp@(12),sp@-
  6382.         movl    sp@(12),sp@-
  6383.         bsr     _dvmdii
  6384.         lea     sp@(12),sp
  6385.         rts
  6386.  
  6387. #===================================================================#
  6388. #                                                                   #
  6389. #                       Operations par valeur                       #
  6390. #                                                                   #
  6391. #       entree : a7@(4) contient n2 de type S ou pointe sur n2      #
  6392. #                de type I ou R                                     #
  6393. #                a7@(8) contient n1 de type S ou pointe sur n1      #
  6394. #                de type I ou R                                     #
  6395. #                a7@(12) pointe sur n3 de type I ou R               #
  6396. #       sortie : la zone pointee par a7@(12) contient n2 op n1      #
  6397. #       remarque : les erreurs de type sont detectees dans l'       #
  6398. #                  affectation du resultat                          #
  6399. #                                                                   #
  6400. #===================================================================#
  6401.  
  6402.                                 | operation a trois operandes
  6403.                                 | les trois operandes sont de type I
  6404.  
  6405. mpariz: movb    sp@(12)@,d0
  6406.         addb    sp@(8)@,d0
  6407.         addb    sp@(4)@,d0
  6408.         cmpb    #3,d0
  6409.         beq     mpopz
  6410.         movl    #arier1,sp@-
  6411.         jsr     _err    
  6412.  
  6413.                                 | le troisieme operande est de type I
  6414.  
  6415. mpopi:  cmpb    #1,sp@(12)@
  6416.         beq     mpopz
  6417.         movl    #arier2,sp@-
  6418.         jsr     _err
  6419.                                 | operation quelconque
  6420.  
  6421. mpopz:  movl    sp@(8),sp@-     | 2eme operande
  6422.         movl    sp@(8),sp@-     | 1er operande
  6423.         jsr     a0@
  6424.         movl    sp@(20),sp@(4)  | 3eme operande
  6425.         movl    d0,sp@          | resultat operation
  6426.         jsr     _mpaff
  6427.         addql   #8,sp
  6428.         movl    d0,a0
  6429.         bra     giv
  6430.  
  6431.                                 | operation a quatre operandes
  6432.                                 | avec deux resultats de type I
  6433.  
  6434. mpopii: movb    sp@(16)@,d0
  6435.         addb    sp@(12)@,d0
  6436.         cmpb    #2,d0
  6437.         beq     mpopz2
  6438.         movl    #arier2,sp@-
  6439.         jsr     _err
  6440.  
  6441.                                 | operation a quatre operande
  6442.  
  6443. mpopz2: link    a6,#-8
  6444.         movl    _avma,a6@(-8)
  6445.         pea     a6@(-4)
  6446.         movl    a6@(12),sp@-    | 2eme operande
  6447.         movl    a6@(8),sp@-     | 1er operande
  6448.         jsr     a0@
  6449.         addql   #4,sp
  6450.         movl    a6@(-4),sp@
  6451.         movl    a6@(20),sp@(4)
  6452.         bsr     _mpaff          | rangement 2 eme resultat
  6453.         movl    d0,sp@
  6454.         movl    a6@(16),sp@(4)
  6455.         bsr     _mpaff          | rangement 1 er resultat
  6456.         addql   #8,sp
  6457.         movl    a6@(-8),_avma
  6458.         unlk    a6
  6459.         rts
  6460.  
  6461.  
  6462.  
  6463.  
  6464.  
  6465. #*******************************************************************#
  6466. #*******************************************************************#
  6467. #**                                                               **#
  6468. #**     PROGRAMMES PAR VALEUR UTILISES POUR LA LECTURE-ECRITURE   **#
  6469. #**                                                               **#
  6470. #*******************************************************************#
  6471. #*******************************************************************#
  6472.  
  6473.  
  6474.  
  6475.  
  6476.  
  6477. #===================================================================#
  6478. #                                                                   #
  6479. #       Multiplication par valeur : entier court * entier = entier  #
  6480. #                                                                   #
  6481. #       entree : a7@(4) contient s2 de type S                       #
  6482. #                a7@(8) pointe sur i1 de type I                     #
  6483. #                a7@(12) pointe sur i3 de type I                    #
  6484. #       sortie : i3 pointe sur s2 * i1                              #
  6485. #                                                                   #
  6486. #===================================================================#
  6487.  
  6488. _mulsii:movl    sp@(8),sp@-
  6489.         movl    sp@(8),sp@-
  6490.         bsr     _mulsi
  6491.         movl    sp@(20),sp@(4)
  6492.         movl    d0,sp@
  6493.         bsr     _affii
  6494.         movl    sp@,a0
  6495.         addql   #8,sp
  6496.         bra     giv
  6497.  
  6498. #===================================================================#
  6499. #                                                                   #
  6500. #       Addition par valeur : entier court + entier = entier        #
  6501. #                                                                   #
  6502. #       entree : a7@(4) contient s2 de type S                       #
  6503. #                a7@(8) pointe sur i1 de type I                     #
  6504. #                a7@(12) pointe sur i3 de type I                    #
  6505. #       sortie : i3 pointe sur s2 + i1                              #
  6506. #                                                                   #
  6507. #===================================================================#
  6508.  
  6509. _addsii:movl    sp@(8),sp@-
  6510.         movl    sp@(8),sp@-
  6511.         bsr     _addsi
  6512.         movl    sp@(20),sp@(4)
  6513.         movl    d0,sp@
  6514.         bsr     _affii
  6515.         movl    sp@,a0
  6516.         addql   #8,sp
  6517.         bra     giv
  6518.  
  6519. #===================================================================#
  6520. #                                                                   #
  6521. #                       division I / S = I                          #
  6522. #                                                                   #
  6523. #       entree: a7@(4) pointe sur i2, a7@(8) contient s1            #
  6524. #               a7@(12) pointe sur un type I                        #
  6525. #       sortie: a7@(12) pointe sur i2 div s1                        #
  6526. #               d1 contient i2 mod s1                               #
  6527. #                                                                   #
  6528. #===================================================================#
  6529.  
  6530. _divisii:movl   sp@(8),sp@-
  6531.         movl    sp@(8),sp@-
  6532.         bsr     _divis
  6533.         movl    sp@(20),sp@(4)
  6534.         movl    d0,sp@
  6535.         bsr     _affii
  6536.         movl    sp@,a0
  6537.         addql   #8,sp
  6538.         bra     giv
  6539.  
  6540.         
  6541. #===================================================================#
  6542. #                                                                   #
  6543. #       Conversion  type I --> base 10^9                            #
  6544. #                                                                   #
  6545. #       entree : a7@(4) pointe sur un type I                        #
  6546. #       sortie : le resultat recoit I converti en base 10^9,        #
  6547. #                sans signe, avec un -1 artificiel au debut         #
  6548. #                d0 pointe apres la zone du resultat                #
  6549. #                                                                   #
  6550. #===================================================================#
  6551.  
  6552. _convi: link    a6,#0
  6553.         moveml  d2/a2-a3,sp@-
  6554.         movl    _avma,d2
  6555.         movl    a6@(8),sp@-
  6556.         bsr     _absi
  6557.         movl    d0,a3
  6558.         movw    a3@(6),d0
  6559.         subqw   #2,d0
  6560.         mulu    #15,d0
  6561.         divu    #14,d0
  6562.         addqw   #3,d0
  6563.         bsr     geti
  6564.         movl    a0,a2
  6565.         addql   #4,a2
  6566.         movl    #-1,a2@+
  6567.         movl    a3,sp@-
  6568.         movl    #1000000000,sp@-
  6569.         movl    a3,sp@-
  6570.         tstb    a3@(4)
  6571.         bne     1$
  6572.         clrl    a2@+            | ici entier nul
  6573.         bra     2$              
  6574. 1$:     bsr     _divisii
  6575.         movl    d1,a2@+
  6576.         tstb    a3@(4)
  6577.         bne     1$
  6578. 2$:     lea     sp@(16),sp
  6579.         movl    a2,d0
  6580.         movl    d2,_avma
  6581.         moveml  sp@+,d2/a2-a3
  6582.         unlk    a6
  6583. convif: rts
  6584.  
  6585. #===================================================================#
  6586. #                                                                   #
  6587. #       Conversion partie fractionnaire --> base 10^9               #
  6588. #                                                                   #
  6589. #       entree : a7@(4) pointe sur un type R de module < 1          #
  6590. #       sortie : le resultat en base 10^9 precede par nb de dec.    #
  6591. #                d0 pointe sur le resultat                          #
  6592. #                                                                   #
  6593. #===================================================================#
  6594.  
  6595. _confrac:link   a6,#-12
  6596.         moveml  d2-d7/a2-a3,sp@-
  6597.         movl    _avma,a6@(-8)
  6598.         movl    a6@(8),a1
  6599.         clrl    d0
  6600.         movw    a1@(2),d0
  6601.         movl    a1@(4),d1
  6602.         andl    #0xffffff,d1
  6603.         subl    #0x800000,d1
  6604.         notl    d1
  6605.         movl    d1,d7           | d1 et d7 recoivent -e-1
  6606.         subql   #2,d0           | d0 recoit L
  6607.         lsll    #5,d0
  6608.         addl    d1,d0
  6609.         movl    d0,d2           | d0 et d2 recoivent 32*L-e-1
  6610.         addl    #95,d0          | 95=3*32-1
  6611.         lsrl    #5,d0
  6612.         bsr     geti            | alloc. pour mantisse denormalisee
  6613.         movl    d0,a6@(-4)
  6614.         lsrl    #5,d7           | d7 recoit -e-1 div 32
  6615.         movl    a0,a2
  6616.         bra     1$
  6617. 2$:     clrl    a0@+
  6618. 1$:     dbra    d7,2$
  6619.         movw    a1@(2),d3
  6620.         subql   #3,d3           | d3 recoit L-1 compteur
  6621.         addql   #8,a1
  6622.         andl    #31,d1          | d1 recoit -e-1 mod 32 = nb de shifts
  6623.         bne     3$
  6624.                                 | ici pas de shift
  6625. 4$:     movl    a1@+,a0@+
  6626.         dbra    d3,4$
  6627.         bra     5$
  6628. 3$:     moveq   #-1,d6
  6629.         lsrl    d1,d6           | masque de shift
  6630.         moveq   #0,d4
  6631. 6$:     movl    a1@+,d0
  6632.         rorl    d1,d0
  6633.         movl    d0,d5
  6634.         andl    d6,d5
  6635.         subl    d5,d0
  6636.         addl    d4,d5
  6637.         movl    d5,a0@+
  6638.         movl    d0,d4
  6639.         dbra    d3,6$
  6640.         movl    d4,a0@+
  6641. 5$:     clrl    a0@
  6642.         mulul   #8651,d3:d2
  6643.         divul   #28738,d3:d2    | on mult par Log(2)/Log(10)=0.30103
  6644.         movl    d2,d0
  6645.         addql   #1,d0
  6646.         movl    d0,d7           | d0,d7 <-- ndecfrac=nb de decimales
  6647.         addl    #17,d0          | 17=2*9-1
  6648.         divu    #9,d0
  6649.         bsr     geti            | alloc memoire pour resultats
  6650.         movl    a0,a6@(-12)     | adresse resultats
  6651.         movl    d7,a0@+         | ndecfrac est passe au prog C
  6652.         subqw   #2,d0           | d0 recoit compteur nb de mult.
  6653.         movl    a6@(-4),d1      | longueur mantisse denormalisee
  6654.         lea     a2@(0,d1:w:4),a2
  6655.         subql   #1,d1
  6656.         movl    a2,a3           | a2 et a3 pointent apres mant.denorm.
  6657.         movl    d1,d3
  6658.         movl    #1000000000,d6
  6659.         clrl    d7
  6660. boext:  clrl    d2
  6661. 1$:     movl    a2@-,d5
  6662.         mulul   d6,d4:d5
  6663.         addl    d2,d5
  6664.         addxl   d7,d4
  6665.         movl    d5,a2@
  6666.         movl    d4,d2
  6667.         dbra    d1,1$
  6668.         movl    d2,a0@+
  6669.         movl    a3,a2           | adr apres fin mantisse denorm.
  6670.         movl    d3,d1
  6671.         dbra    d0,boext
  6672.         movl    a6@(-12),d0     | d0 pointe sur le resultat
  6673.         moveml  sp@+,d2-d7/a2-a3
  6674.         movl    a6@(-8),_avma
  6675.         unlk    a6
  6676.         rts
  6677.  
  6678.